Oasis3 4.0.2
|
00001 SUBROUTINE invert (pfild ,kxlon ,kylat, cdxord, cdyord) 00002 C**** 00003 C ***************************** 00004 C * OASIS ROUTINE - LEVEL 3 * 00005 C * ------------- ------- * 00006 C ***************************** 00007 C 00008 C**** *invert* - Ordering routine 00009 C 00010 C Purpose: 00011 C ------- 00012 C Reorder field with increasing latitude from south to north 00013 C and longitude going east from Greenwhich. 00014 C 00015 C** Interface: 00016 C --------- 00017 C *CALL* *invert (pfild ,kxlon ,kylat, cdxord, cdyord)* 00018 C 00019 C Input: 00020 C ----- 00021 C pfild : field to be reordered (real 2D) 00022 C kxlon : number of longitudes 00023 C kylat : number of latitudes 00024 C cdxord : latitude ordering 00025 C cdyord : longitude ordering 00026 C 00027 C Output: 00028 C ------ 00029 C pfild : field reordered (real 2D) 00030 C 00031 C Workspace: 00032 C --------- 00033 C None 00034 C 00035 C Externals: 00036 C --------- 00037 C None 00038 C 00039 C Reference: 00040 C --------- 00041 C See OASIS manual (1995) 00042 C 00043 C History: 00044 C ------- 00045 C Version Programmer Date Description 00046 C ------- ---------- ---- ----------- 00047 C 1.0 L. Terray 94/01/01 created 00048 C 2.0 L. Terray 95/10/10 modified; new structure 00049 C 2.3 S. Valcke 99/04/30 added: printing levels 00050 C 00051 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00052 C 00053 C* ---------------------------- Include files --------------------------- 00054 C 00055 USE mod_unit 00056 USE mod_printing 00057 C 00058 C* ---------------------------- Argument declarations ------------------- 00059 C 00060 REAL (kind=ip_realwp_p) pfild(kxlon,kylat) 00061 CHARACTER*8 cdxord, cdyord 00062 C 00063 C* ---------------------------- Local declarations ---------------------- 00064 C 00065 LOGICAL llxord, llyord 00066 C 00067 C* ---------------------------- Poema verses ---------------------------- 00068 C 00069 C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00070 C 00071 C* 1. Initialization 00072 C -------------- 00073 C 00074 IF (nlogprt .GE. 2) THEN 00075 WRITE (UNIT = nulou,FMT = *)' ' 00076 WRITE (UNIT = nulou,FMT = *)' ROUTINE invert - Level 3' 00077 WRITE (UNIT = nulou,FMT = *)' ************** *******' 00078 WRITE (UNIT = nulou,FMT = *)' ' 00079 WRITE (UNIT = nulou,FMT = *)' Reorder field South ---> North ' 00080 WRITE (UNIT = nulou,FMT = *)' and from Greenwhich ---> East ' 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 = *)'---- End of ROUTINE invert -----' 00123 CALL FLUSH (nulou) 00124 ENDIF 00125 RETURN 00126 END