doc-doxygen/html/reverse_8f_source.html

00001       SUBROUTINE reverse (pfild ,kxlon ,kylat, cdxord, cdyord)
00002 C****
00003 C               *****************************
00004 C               * OASIS ROUTINE  -  LEVEL 3 *
00005 C               * -------------     ------- *
00006 C               *****************************
00007 C
00008 C**** *reverse* - Ordering routine
00009 C
00010 C     Purpose:
00011 C     -------
00012 C     Reorder field according to cdxord and cdyord information
00013 C
00014 C**   Interface:
00015 C     ---------
00016 C       *CALL*  *reverse (pfild ,kxlon ,kylat, cdxord, cdyord)*
00017 C
00018 C     Input:
00019 C     -----
00020 C                pfild : field to be reordered (real 2D)
00021 C                kxlon : number of longitudes
00022 C                kylat : number of latitudes
00023 C                cdxord : latitude ordering
00024 C                cdyord : longitude ordering
00025 C
00026 C     Output:
00027 C     ------
00028 C                pfild : field reordered (real 2D)
00029 C
00030 C     Workspace:
00031 C     ---------
00032 C     None
00033 C
00034 C     Externals:
00035 C     ---------
00036 C     None
00037 C
00038 C     Reference:
00039 C     ---------
00040 C     See OASIS manual (1995)
00041 C
00042 C     History:
00043 C     -------
00044 C       Version   Programmer     Date      Description
00045 C       -------   ----------     ----      -----------
00046 C       1.0       L. Terray      94/01/01  created
00047 C       2.0       L. Terray      95/10/10  modified; new structure
00048 C       2.3       S. Valcke      99/04/30  added: printing levels
00049 C
00050 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00051 C
00052 C* ---------------------------- Include files ---------------------------
00053 C
00054       USE mod_unit
00055       USE mod_printing
00056 C
00057 C* ---------------------------- Argument declarations -------------------
00058 C
00059       REAL (kind=ip_realwp_p) pfild(kxlon,kylat)
00060       CHARACTER*8 cdxord, cdyord
00061 C
00062 C* ---------------------------- Local declarations ----------------------
00063 C
00064       LOGICAL llxord, llyord
00065 C
00066 C* ---------------------------- Poema verses ----------------------------
00067 C
00068 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00069 C
00070 C*    1. Initialization
00071 C        --------------
00072 C
00073       IF (nlogprt .GE. 2) THEN
00074           WRITE (UNIT = nulou,FMT = *)' '
00075           WRITE (UNIT = nulou,FMT = *)'     ROUTINE reverse  -  Level 3'
00076           WRITE (UNIT = nulou,FMT = *)'     ***************     *******'
00077           WRITE (UNIT = nulou,FMT = *)' '
00078           WRITE (UNIT = nulou,FMT = *)' Reorder field North ---> South '
00079           WRITE (UNIT = nulou,FMT = *)' and from Greenwhich ---> West '
00080           WRITE (UNIT = nulou,FMT = *)' if necessary '
00081           WRITE (UNIT = nulou,FMT = *)' '
00082           CALL FLUSH(nulou)
00083       ENDIF
00084       llxord = cdxord .EQ. 'SUDNOR'
00085       llyord = cdyord .EQ. 'WSTEST'
00086 C
00087 C
00088 C*    2. Reorder field
00089 C        -------------
00090 C* South-North buisness
00091 C
00092       IF ( .NOT. llxord) THEN
00093           ijmed = kylat/2
00094           DO 210 jj = 1, ijmed
00095             DO 220 ji = 1, kxlon
00096               zfild = pfild(ji,kylat + 1 - jj)
00097               pfild(ji,kylat + 1 - jj) = pfild(ji,jj)
00098               pfild(ji,jj) = zfild
00099  220        CONTINUE
00100  210      CONTINUE
00101       ENDIF
00102 C
00103 C* East-West one
00104 C
00105       IF ( .NOT. llyord) THEN
00106           iimed = kxlon/2
00107           DO 230 jj = 1, kylat
00108             DO 240 ji = 1, iimed
00109               zfild = pfild(kxlon + 1 - ji,jj)
00110               pfild(kxlon + 1 - ji,jj) = pfild(ji,jj)
00111               pfild(ji,jj) = zfild
00112  240        CONTINUE
00113  230      CONTINUE
00114       ENDIF
00115 C
00116 C
00117 C*    3. End of routine
00118 C        --------------
00119 C
00120       IF (nlogprt .GE. 2) THEN
00121           WRITE (UNIT = nulou,FMT = *) ' '
00122           WRITE (UNIT = nulou,FMT = *)
00123      $    '          --------- End of ROUTINE reverse ---------'
00124           CALL FLUSH (nulou)
00125       ENDIF
00126       RETURN
00127       END