doc-doxygen/html/revmsk_8f_source.html

00001       SUBROUTINE revmsk (kfild ,kxlon ,kylat, cdxord, cdyord)
00002 C****
00003 C               *****************************
00004 C               * OASIS ROUTINE  -  LEVEL 3 *
00005 C               * -------------     ------- *
00006 C               *****************************
00007 C
00008 C**** *revmsk* - Ordering routine
00009 C
00010 C     Purpose:
00011 C     -------
00012 C     Reorder integer field according to cdxord and cdyord information
00013 C
00014 C**   Interface:
00015 C     ---------
00016 C       *CALL*  *revmsk (kfild ,kxlon ,kylat, cdxord, cdyord)*
00017 C
00018 C     Input:
00019 C     -----
00020 C                kfild : field to be reordered (integer 2D)
00021 C                kxlon : number of longitudes
00022 C                kylat : number of latitudes
00023 C                cdxord : longitude ordering
00024 C                cdyord : latitude ordering
00025 C
00026 C     Output:
00027 C     ------
00028 C                kfild : field reordered (integer 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       2.0       L. Terray      95/10/10  created
00047 C       2.3       S. Valcke      99/04/30  added: printing levels
00048 C
00049 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00050 C
00051 C* ---------------------------- Include files ---------------------------
00052 C
00053       USE mod_unit
00054       USE mod_printing
00055 C
00056 C* ---------------------------- Argument declarations -------------------
00057 C
00058       INTEGER (kind=ip_intwp_p) kfild(kxlon,kylat)
00059       CHARACTER*8 cdxord, cdyord
00060 C
00061 C* ---------------------------- Local declarations ----------------------
00062 C
00063       LOGICAL llxord, llyord
00064 C
00065 C* ---------------------------- Poema verses ----------------------------
00066 C
00067 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
00068 C
00069 C*    1. Initialization
00070 C        --------------
00071 C
00072       IF (nlogprt .GE. 2) THEN
00073           WRITE (UNIT = nulou,FMT = *) ' '
00074           WRITE (UNIT = nulou,FMT = *) ' '
00075           WRITE (UNIT = nulou,FMT = *)
00076      $    '           ROUTINE revmsk     Level 3'
00077           WRITE (UNIT = nulou,FMT = *)
00078      $    '           **************     *******'
00079           WRITE (UNIT = nulou,FMT = *) ' '
00080           WRITE (UNIT = nulou,FMT = *)
00081      $    ' Reorder mask field North ---> South '
00082           WRITE (UNIT = nulou,FMT = *)
00083      $    '      and from Greenwhich ---> West '
00084           WRITE (UNIT = nulou,FMT = *)
00085      $    ' if necessary for glored analysis'
00086           WRITE (UNIT = nulou,FMT = *) ' '
00087           WRITE (UNIT = nulou,FMT = *) ' '
00088           CALL FLUSH(nulou)
00089       ENDIF
00090       llxord = cdxord .EQ. 'SUDNOR'
00091       llyord = cdyord .EQ. 'WSTEST'
00092 C
00093 C
00094 C*    2. Reorder field
00095 C        -------------
00096 C* South-North buisness
00097 C
00098       IF ( .NOT. llxord) THEN
00099           ijmed = kylat/2
00100           DO 210 jj = 1, ijmed
00101             DO 220 ji = 1, kxlon
00102               ifild = kfild(ji,kylat + 1 - jj)
00103               kfild(ji,kylat + 1 - jj) = kfild(ji,jj)
00104               kfild(ji,jj) = ifild
00105  220        CONTINUE
00106  210      CONTINUE
00107       ENDIF
00108 C
00109 C* East-West one
00110 C
00111       IF ( .NOT. llyord) THEN
00112           iimed = kxlon/2
00113           DO 230 jj = 1, kylat
00114             DO 240 ji = 1, iimed
00115               ifild = kfild(kxlon + 1 - ji,jj)
00116               kfild(kxlon + 1 - ji,jj) = kfild(ji,jj)
00117               kfild(ji,jj) = ifild
00118  240        CONTINUE
00119  230      CONTINUE
00120       ENDIF
00121 C
00122 C
00123 C*    3. End of routine
00124 C        --------------
00125 C
00126       IF (nlogprt .GE. 2) THEN
00127           WRITE (UNIT = nulou,FMT = *) ' '
00128           WRITE (UNIT = nulou,FMT = *)
00129      $    '          --------- End of ROUTINE revmsk ---------'
00130           CALL FLUSH (nulou)
00131       ENDIF
00132       RETURN
00133       END