|
Oasis3 4.0.2
|
|
Oasis3 4.0.2
|
00001 MODULE mod_clim_def 00002 ! 00003 ! 00004 !**** DEFINE 00005 ! 00006 ! Purpose: 00007 ! Routines CLIM_Define and CLIM_Defport are now in a module. 00008 ! 00009 ! Interface: 00010 ! none 00011 ! 00012 ! Method: 00013 ! Uses assumed shape array method to dimension local arrays. 00014 ! 00015 ! External: 00016 ! none 00017 ! 00018 ! Files: 00019 ! none 00020 ! 00021 ! References: 00022 ! 00023 ! History: 00024 ! -------- 00025 ! Version Programmer Date Description 00026 ! ------------------------------------------------ 00027 ! 2.5 A.Caubel 2002/06 created 00028 ! 00029 !*----------------------------------------------------------------------- 00030 00031 CONTAINS 00032 ! 00033 SUBROUTINE CLIM_Define(id_nports, cdport,kinout,ktype,kparal,kinfo) 00034 ! 00035 !* *** Define *** CLIM 2.0 00036 ! 00037 ! purpose: 00038 ! -------- 00039 ! define a port 00040 ! 00041 ! interface: 00042 ! ---------- 00043 ! id_nports : port number of the field 00044 ! cdport : symbolic name of the field 00045 ! kinout : port status in/out 00046 ! ktype : type of data 00047 ! kparal : type of parallel decomposition 00048 ! kinfo : output status 00049 ! 00050 ! lib mp: 00051 ! ------- 00052 ! mpi-1 00053 ! 00054 ! author: 00055 ! ------- 00056 ! Eric Sevault - METEO FRANCE 00057 ! Laurent Terray - CERFACS 00058 ! Arnaud Caubel - Fecit 00059 ! ---------------------------------------------------------------- 00060 #if defined use_comm_MPI1 || defined use_comm_MPI2 || (!defined use_comm_MPI1 && !defined use_comm_MPI2 && !defined use_comm_SIPC && !defined use_comm_GMEM && !defined use_comm_PIPE && !defined use_comm_NONE) 00061 USE mod_kinds_oasis 00062 USE mod_clim 00063 USE mod_comclim 00064 ! ---------------------------------------------------------------- 00065 INTEGER(kind=ip_intwp_p) kinout, ktype, kinfo, id_nports 00066 INTEGER(kind=ip_intwp_p), DIMENSION(:) :: kparal 00067 CHARACTER*(*) cdport 00068 ! ---------------------------------------------------------------- 00069 ! 00070 !* 0. Entering 00071 ! ----------- 00072 ! 00073 kinfo = CLIM_Ok 00074 ! 00075 !* 1. define the port 00076 ! ------------------ 00077 ! 00078 #ifdef __VERBOSE 00079 WRITE(nulprt,*) 'Entering CLIM_Define' 00080 WRITE(nulprt,*) 'Define - port name, status : ',cdport,kinout 00081 WRITE(nulprt,*) 'Define - data type: ',ktype 00082 CALL FLUSH(nulprt) 00083 #endif 00084 ! 00085 IF ( kinout.EQ.CLIM_InOut ) THEN 00086 CALL CLIM_Defport (id_nports,cdport, CLIM_In, ktype, kparal, kinfo ) 00087 IF (kinfo.EQ.CLIM_Ok) THEN 00088 CALL CLIM_Defport (id_nports,cdport,CLIM_Out,ktype,kparal,kinfo ) 00089 ENDIF 00090 ELSE 00091 CALL CLIM_Defport ( id_nports,cdport, kinout, ktype, kparal, kinfo ) 00092 ENDIF 00093 ! 00094 ! ---------------------------------------------------------------- 00095 ! 00096 #ifdef __VERBOSE 00097 WRITE(nulprt,*) 'Leaving CLIM_Define' 00098 CALL FLUSH(nulprt) 00099 #endif 00100 #endif 00101 RETURN 00102 END SUBROUTINE CLIM_Define 00103 ! 00104 ! ==================================================================== 00105 00106 SUBROUTINE CLIM_Defport(id_nports,cdport,kinout,ktype,kparal,kinfo) 00107 ! 00108 !* *** Define *** CLIM 2.2 00109 ! 00110 ! purpose: 00111 ! -------- 00112 ! define a port 00113 ! 00114 ! interface: 00115 ! ---------- 00116 ! id_nports : port number of the field 00117 ! cdport : symbolic name of the field 00118 ! kinout : port status in/out 00119 ! ktype : type of data 00120 ! kparal : type of parallel decomposition 00121 ! kinfo : output status 00122 ! 00123 ! lib mp: 00124 ! ------- 00125 ! mpi-2 00126 ! 00127 ! author: 00128 ! ------- 00129 ! Eric Sevault - METEO FRANCE 00130 ! Laurent Terray - CERFACS 00131 ! Jean Latour - F.S.E. (mpi-2) 00132 ! 00133 ! ---------------------------------------------------------------- 00134 #if defined use_comm_MPI1 || defined use_comm_MPI2 || (!defined use_comm_MPI1 && !defined use_comm_MPI2 && !defined use_comm_SIPC && !defined use_comm_GMEM && !defined use_comm_PIPE && !defined use_comm_NONE) 00135 USE mod_kinds_oasis 00136 USE mod_clim 00137 USE mod_comclim 00138 ! ---------------------------------------------------------------- 00139 INTEGER(kind=ip_intwp_p) kinout, ktype, kinfo 00140 INTEGER(kind=ip_intwp_p), DIMENSION(:) :: kparal 00141 CHARACTER*(*) cdport 00142 ! ---------------------------------------------------------------- 00143 INTEGER(kind=ip_intwp_p) ip, is, id_nports 00144 REAL(kind=ip_realwp_p) rl_testvar 00145 REAL(kind=ip_double_p) dl_testvar 00146 CHARACTER*32 cltest 00147 INTEGER (kind=ip_intwp_p) :: il_testvar, il_bytesize, il_iosize 00148 INTEGER (kind=ip_intwp_p) :: il_int_iosize, il_rbyt 00149 ! ---------------------------------------------------------------- 00150 ! 00151 #ifdef __VERBOSE 00152 WRITE(nulprt,*) 'Entering CLIM_Defport for field ', cdport 00153 CALL FLUSH(nulprt) 00154 #endif 00155 !* 1. check if this port already exist 00156 ! ----------------------------------- 00157 ! 00158 cltest= cdport 00159 il_testvar = 0 00160 rl_testvar = 0.0 00161 dl_testvar = 0.0 00162 ! 00163 DO ip=1,nports 00164 IF (cltest.EQ.cports(ip).AND.kinout.EQ.myport(1,ip)) THEN 00165 kinfo = CLIM_DoubleDef 00166 WRITE(nulprt,FMT='(A,A)') & 00167 'Define - WARNING - duplicate definition of port ', & 00168 cdport 00169 #ifdef __VERBOSE 00170 CALL FLUSH(nulprt) 00171 #endif 00172 GO TO 1010 00173 ENDIF 00174 ENDDO 00175 ! 00176 !* 2. save arguments as half a link 00177 ! -------------------------------- 00178 ! 00179 nports = nports + 1 00180 id_nports = nports 00181 cports(nports) = cdport 00182 ! 00183 myport(1,nports) = kinout 00184 myport(5,nports) = 0 00185 ! 00186 IF ( ktype.EQ.CLIM_Real ) THEN 00187 myport(2,nports) = CLIM_Real 00188 il_bytesize = BIT_SIZE(il_testvar)/8 00189 INQUIRE (iolength=il_iosize) il_testvar 00190 il_int_iosize = il_iosize 00191 INQUIRE (iolength=il_iosize) rl_testvar 00192 il_rbyt = il_iosize/il_int_iosize*il_bytesize 00193 myport(3,nports) = il_rbyt 00194 ELSE 00195 kinfo = CLIM_BadType 00196 WRITE(nulprt,FMT='(A,I4)') & 00197 'Define - WARNING - Bad data type:',ktype 00198 #ifdef __VERBOSE 00199 CALL FLUSH(nulprt) 00200 #endif 00201 ENDIF 00202 ! 00203 IF (kparal(CLIM_Strategy).EQ.CLIM_Serial) THEN 00204 ! 00205 mydist(CLIM_Strategy,nports) = CLIM_Serial 00206 mydist(CLIM_Segments,nports) = 1 00207 mydist(CLIM_Segments+1,nports) = 0 00208 mydist(CLIM_Segments+2,nports) = kparal(CLIM_Length) 00209 myport(4,nports) = kparal(CLIM_Length) 00210 ! 00211 ELSEIF (kparal(CLIM_Strategy).EQ.CLIM_Apple) THEN 00212 ! 00213 mydist(CLIM_Strategy,nports) = CLIM_Apple 00214 mydist(CLIM_Segments,nports) = 1 00215 mydist(CLIM_Segments+1,nports) = kparal(CLIM_Offset) 00216 mydist(CLIM_Segments+2,nports) = kparal(CLIM_Length) 00217 myport(4,nports) = kparal(CLIM_Length) 00218 ! 00219 ELSEIF (kparal(CLIM_strategy).EQ.CLIM_Box) THEN 00220 ! 00221 mydist(CLIM_Strategy,nports) = CLIM_Box 00222 mydist(CLIM_Segments,nports) = kparal(CLIM_SizeY) 00223 DO is=1,kparal(CLIM_SizeY) 00224 mydist(CLIM_Segments+2*is-1,nports) = & 00225 kparal(CLIM_Offset) + (is-1) * kparal(CLIM_LdX) 00226 mydist(CLIM_Segments+2*is,nports) = kparal(CLIM_SizeX) 00227 ENDDO 00228 myport(4,nports) = kparal(CLIM_SizeX) * kparal(CLIM_SizeY) 00229 ! 00230 ELSEIF (kparal(CLIM_strategy).EQ.CLIM_Orange) THEN 00231 ! 00232 mydist(CLIM_Strategy,nports) = CLIM_Orange 00233 mydist(CLIM_Segments,nports) = kparal(CLIM_Segments) 00234 myport(4,nports) = 0 00235 DO is=1,2*kparal(CLIM_Segments) 00236 mydist(CLIM_Segments+is,nports) = kparal(CLIM_Segments+is) 00237 IF (MOD(is,2).EQ.0) THEN 00238 myport(4,nports) = myport(4,nports) + & 00239 kparal(CLIM_Segments+is) 00240 ENDIF 00241 ENDDO 00242 ENDIF 00243 ! 00244 ! ---------------------------------------------------------------- 00245 ! 00246 1010 CONTINUE 00247 #ifdef __VERBOSE 00248 WRITE(nulprt, *)'Leaving CLIM_Defport' 00249 CALL FLUSH(nulprt) 00250 #endif 00251 #endif 00252 RETURN 00253 END SUBROUTINE CLIM_Defport 00254 END MODULE mod_clim_def
1.7.4 
