*IF DEF,C72_1A,AND,DEF,ATMOS,AND,DEF,OCEAN GLW1F404.50 C ******************************COPYRIGHT****************************** GTS2F400.8335 C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.8336 C GTS2F400.8337 C Use, duplication or disclosure of this code is subject to the GTS2F400.8338 C restrictions as set forth in the contract. GTS2F400.8339 C GTS2F400.8340 C Meteorological Office GTS2F400.8341 C London Road GTS2F400.8342 C BRACKNELL GTS2F400.8343 C Berkshire UK GTS2F400.8344 C RG12 2SZ GTS2F400.8345 C GTS2F400.8346 C If no contract has been raised with this copy of the code, the use, GTS2F400.8347 C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.8348 C to do so must first be obtained in writing from the Head of Numerical GTS2F400.8349 C Modelling at the above address. GTS2F400.8350 C ******************************COPYRIGHT****************************** GTS2F400.8351 C GTS2F400.8352 C*LL ROWSWAP1.3 CLL SUBROUTINE ROWSWAP ROWSWAP1.4 CLL ------------------ ROWSWAP1.5 CLL ROWSWAP1.6 CLL THIS ROUTINE INVERTS THE ORDER OF THE ROWS IN A TWO-DIMENSIONAL ROWSWAP1.7 CLL ARRAY, FACILITATING COUPLING AN OCEAN MODEL IN WHICH THE FIRST ROWSWAP1.8 CLL ROW IS AT THE SOUTH EDGE WITH AN ATMOSPHERE MODEL IN WHICH THE ROWSWAP1.9 CLL ROWS START AT THE NORTH EDGE. IT IS CALLED BY TRANSO2A AND BY ROWSWAP1.10 CLL TRANSA2O. ROWSWAP1.11 CLL A WORK ARRAY IS USED IN ORDER THAT THE ROUTINE CAN BE CALLED ROWSWAP1.12 CLL WITH THE SAME FIELD AS INPUT AND OUTPUT ARGUMENTS, IF REQUIRED. ROWSWAP1.13 CLL ROWSWAP1.14 CLL ROUTINE WRITTEN BY D.L.ROBERTS ROWSWAP1.15 CLL ROWSWAP1.16 CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: ROWSWAP1.17 CLL VERSION DATE ROWSWAP1.18 CLL ROWSWAP1.19 CLL THIS IS SYSTEM COMPONENT S193 (PART OF TASK D2). ROWSWAP1.20 CLL ROWSWAP1.21 CLL THIS ROUTINE CAN BE COMPILED BY CFT77 BUT DOES NOT CONFORM TO ROWSWAP1.22 CLL FORTRAN77 STANDARDS, BECAUSE OF THE INLINE COMMENTS. IT FOLLOWS ROWSWAP1.23 CLL VERSION 1 OF DOCUMENTATION PAPER NO. 3. ROWSWAP1.24 CLL ROWSWAP1.25 CLLEND ROWSWAP1.26 C ROWSWAP1.27SUBROUTINE ROWSWAP(UP,DOWN,ICOLS,JROWS) 2ROWSWAP1.28 C --------------------------------------- ROWSWAP1.29 C ROWSWAP1.30 IMPLICIT NONE ROWSWAP1.31 C*L ROWSWAP1.32 INTEGER ICOLS ! IN NUMBER OF COLUMNS IN FIELD ROWSWAP1.33 INTEGER JROWS ! IN NUMBER OF ROWS IN FIELD ROWSWAP1.34 REAL UP(ICOLS,JROWS) ! IN INPUT ARRAY ROWSWAP1.35 REAL DOWN(ICOLS,JROWS) ! OUT OUTPUT ARRAY ROWSWAP1.36 C* ROWSWAP1.37 INTEGER ROWSWAP1.38 + I,J ! LOOP COUNTERS ROWSWAP1.39 C ROWSWAP1.40 REAL WORK(ICOLS,JROWS) ! WORK ARRAY ROWSWAP1.41 C ROWSWAP1.42 DO 200 J = 1,JROWS ROWSWAP1.43 DO 100 I = 1,ICOLS ROWSWAP1.44 WORK(I,J) = UP(I,J) ROWSWAP1.45 100 CONTINUE ROWSWAP1.46 200 CONTINUE ROWSWAP1.47 C ROWSWAP1.48 DO 400 J = 1,JROWS ROWSWAP1.49 DO 300 I = 1,ICOLS ROWSWAP1.50 DOWN(I,J) = WORK(I,JROWS+1-J) ROWSWAP1.51 300 CONTINUE ROWSWAP1.52 400 CONTINUE ROWSWAP1.53 C ROWSWAP1.54 RETURN ROWSWAP1.55 END ROWSWAP1.56 *ENDIF ROWSWAP1.57