Changeset 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
- Timestamp:
- 2015-12-01T16:35:30+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r3294 r5965 2 2 !!====================================================================== 3 3 !! *** MODULE cpl_oasis *** 4 !! Coupled O/A : coupled ocean-atmosphere case using OASIS3 V. prism_2_4 5 !! special case: NEMO OPA/LIM coupled to ECHAM5 4 !! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT 6 5 !!===================================================================== 7 6 !! History : … … 15 14 !! 3.4 ! 11-11 (C. Harris) Changes to allow mutiple category fields 16 15 !!---------------------------------------------------------------------- 16 !!---------------------------------------------------------------------- 17 !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3-MCT 18 !! 'key_oa3mct_v3' to be added for OASIS3-MCT version 3 19 !!---------------------------------------------------------------------- 20 !! cpl_init : initialization of coupled mode communication 21 !! cpl_define : definition of grid and fields 22 !! cpl_snd : snd out fields in coupled mode 23 !! cpl_rcv : receive fields in coupled mode 24 !! cpl_finalize : finalize the coupled mode communication 25 !!---------------------------------------------------------------------- 17 26 #if defined key_oasis3 18 !!---------------------------------------------------------------------- 19 !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3 20 !!---------------------------------------------------------------------- 21 !! cpl_prism_init : initialization of coupled mode communication 22 !! cpl_prism_define : definition of grid and fields 23 !! cpl_prism_snd : snd out fields in coupled mode 24 !! cpl_prism_rcv : receive fields in coupled mode 25 !! cpl_prism_finalize : finalize the coupled mode communication 26 !!---------------------------------------------------------------------- 27 USE mod_prism_proto ! OASIS3 prism module 28 USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning 29 USE mod_prism_put_proto ! OASIS3 prism module for snding 30 USE mod_prism_get_proto ! OASIS3 prism module for receiving 31 USE mod_comprism_proto ! OASIS3 prism module to get coupling frequency 27 USE mod_oasis ! OASIS3-MCT module 28 #endif 32 29 USE par_oce ! ocean parameters 33 30 USE dom_oce ! ocean space and time domain … … 38 35 PRIVATE 39 36 40 PUBLIC cpl_prism_init 41 PUBLIC cpl_prism_define 42 PUBLIC cpl_prism_snd 43 PUBLIC cpl_prism_rcv 44 PUBLIC cpl_prism_freq 45 PUBLIC cpl_prism_finalize 46 47 LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE. !: coupled flag 37 PUBLIC cpl_init 38 PUBLIC cpl_define 39 PUBLIC cpl_snd 40 PUBLIC cpl_rcv 41 PUBLIC cpl_freq 42 PUBLIC cpl_finalize 43 48 44 INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field 49 45 INTEGER, PUBLIC :: OASIS_idle = 0 !: return code if nothing done by oasis 50 INTEGER :: ncomp_id ! id returned by prism_init_comp46 INTEGER :: ncomp_id ! id returned by oasis_init_comp 51 47 INTEGER :: nerror ! return error code 52 53 INTEGER, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields 48 #if ! defined key_oasis3 49 ! OASIS Variables not used. defined only for compilation purpose 50 INTEGER :: OASIS_Out = -1 51 INTEGER :: OASIS_REAL = -1 52 INTEGER :: OASIS_Ok = -1 53 INTEGER :: OASIS_In = -1 54 INTEGER :: OASIS_Sent = -1 55 INTEGER :: OASIS_SentOut = -1 56 INTEGER :: OASIS_ToRest = -1 57 INTEGER :: OASIS_ToRestOut = -1 58 INTEGER :: OASIS_Recvd = -1 59 INTEGER :: OASIS_RecvOut = -1 60 INTEGER :: OASIS_FromRest = -1 61 INTEGER :: OASIS_FromRestOut = -1 62 #endif 63 64 INTEGER :: nrcv ! total number of fields received 65 INTEGER :: nsnd ! total number of fields sent 66 INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 67 INTEGER, PUBLIC, PARAMETER :: nmaxfld=50 ! Maximum number of coupling fields 68 INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 69 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields 54 70 55 71 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information … … 58 74 CHARACTER(len = 1) :: clgrid ! Grid type 59 75 REAL(wp) :: nsgn ! Control of the sign change 60 INTEGER, DIMENSION( 9) :: nid ! Id of the field (no more than 9 categories)76 INTEGER, DIMENSION(nmaxcat,nmaxcpl) :: nid ! Id of the field (no more than 9 categories and 9 extrena models) 61 77 INTEGER :: nct ! Number of categories in field 78 INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received 62 79 END TYPE FLD_CPL 63 80 … … 73 90 CONTAINS 74 91 75 SUBROUTINE cpl_ prism_init(kl_comm )92 SUBROUTINE cpl_init( cd_modname, kl_comm ) 76 93 !!------------------------------------------------------------------- 77 !! *** ROUTINE cpl_ prism_init ***94 !! *** ROUTINE cpl_init *** 78 95 !! 79 96 !! ** Purpose : Initialize coupled mode communication for ocean … … 82 99 !! ** Method : OASIS3 MPI communication 83 100 !!-------------------------------------------------------------------- 84 INTEGER, INTENT(out) :: kl_comm ! local communicator of the model 101 CHARACTER(len = *), INTENT(in) :: cd_modname ! model name as set in namcouple file 102 INTEGER , INTENT(out) :: kl_comm ! local communicator of the model 85 103 !!-------------------------------------------------------------------- 86 104 … … 89 107 90 108 !------------------------------------------------------------------ 91 ! 1st Initialize the PRISMsystem for the application109 ! 1st Initialize the OASIS system for the application 92 110 !------------------------------------------------------------------ 93 CALL prism_init_comp_proto ( ncomp_id, 'oceanx', nerror )94 IF ( nerror /= PRISM_Ok ) &95 CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto')111 CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror ) 112 IF ( nerror /= OASIS_Ok ) & 113 CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') 96 114 97 115 !------------------------------------------------------------------ … … 99 117 !------------------------------------------------------------------ 100 118 101 CALL prism_get_localcomm_proto( kl_comm, nerror )102 IF ( nerror /= PRISM_Ok ) &103 CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' )104 ! 105 END SUBROUTINE cpl_ prism_init106 107 108 SUBROUTINE cpl_ prism_define( krcv, ksnd)119 CALL oasis_get_localcomm ( kl_comm, nerror ) 120 IF ( nerror /= OASIS_Ok ) & 121 CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 122 ! 123 END SUBROUTINE cpl_init 124 125 126 SUBROUTINE cpl_define( krcv, ksnd, kcplmodel ) 109 127 !!------------------------------------------------------------------- 110 !! *** ROUTINE cpl_ prism_define ***128 !! *** ROUTINE cpl_define *** 111 129 !! 112 130 !! ** Purpose : Define grid and field information for ocean … … 116 134 !!-------------------------------------------------------------------- 117 135 INTEGER, INTENT(in) :: krcv, ksnd ! Number of received and sent coupling fields 136 INTEGER, INTENT(in) :: kcplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 118 137 ! 119 138 INTEGER :: id_part 120 139 INTEGER :: paral(5) ! OASIS3 box partition 121 140 INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe 122 INTEGER :: ji,jc ! local loop indicees 123 CHARACTER(LEN=8) :: zclname 141 INTEGER :: ji,jc,jm ! local loop indicees 142 CHARACTER(LEN=64) :: zclname 143 CHARACTER(LEN=2) :: cli2 124 144 !!-------------------------------------------------------------------- 125 145 126 146 IF(lwp) WRITE(numout,*) 127 IF(lwp) WRITE(numout,*) 'cpl_ prism_define : initialization in coupled ocean/atmosphere case'147 IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case' 128 148 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 129 149 IF(lwp) WRITE(numout,*) 150 151 ncplmodel = kcplmodel 152 IF( kcplmodel > nmaxcpl ) THEN 153 CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN 154 ENDIF 155 156 nrcv = krcv 157 IF( nrcv > nmaxfld ) THEN 158 CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld') ; RETURN 159 ENDIF 160 161 nsnd = ksnd 162 IF( nsnd > nmaxfld ) THEN 163 CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld') ; RETURN 164 ENDIF 130 165 131 166 ! … … 141 176 ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror) 142 177 IF( nerror > 0 ) THEN 143 CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld') ; RETURN178 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN 144 179 ENDIF 145 180 ! … … 161 196 ENDIF 162 197 163 CALL prism_def_partition_proto( id_part, paral, nerror )198 CALL oasis_def_partition ( id_part, paral, nerror ) 164 199 ! 165 200 ! ... Announce send variables. 166 201 ! 202 ssnd(:)%ncplmodel = kcplmodel 203 ! 167 204 DO ji = 1, ksnd 168 IF ( ssnd(ji)%laction ) THEN 205 IF ( ssnd(ji)%laction ) THEN 206 207 IF( ssnd(ji)%nct > nmaxcat ) THEN 208 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// & 209 & TRIM(ssnd(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 210 RETURN 211 ENDIF 212 169 213 DO jc = 1, ssnd(ji)%nct 170 IF ( ssnd(ji)%nct .gt. 1 ) THEN 171 WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc 172 ELSE 173 zclname=ssnd(ji)%clname 174 ENDIF 175 WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_Out 176 CALL prism_def_var_proto (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 177 PRISM_Out, ishape, PRISM_REAL, nerror) 178 IF ( nerror /= PRISM_Ok ) THEN 179 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 180 CALL prism_abort_proto ( ssnd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 181 ENDIF 214 DO jm = 1, kcplmodel 215 216 IF ( ssnd(ji)%nct .GT. 1 ) THEN 217 WRITE(cli2,'(i2.2)') jc 218 zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2 219 ELSE 220 zclname = ssnd(ji)%clname 221 ENDIF 222 IF ( kcplmodel > 1 ) THEN 223 WRITE(cli2,'(i2.2)') jm 224 zclname = 'model'//cli2//'_'//TRIM(zclname) 225 ENDIF 226 #if defined key_agrif 227 IF( agrif_fixed() /= 0 ) THEN 228 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 229 END IF 230 #endif 231 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out 232 CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 233 & OASIS_Out , ishape , OASIS_REAL, nerror ) 234 IF ( nerror /= OASIS_Ok ) THEN 235 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 236 CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 237 ENDIF 238 IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 239 IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 240 END DO 182 241 END DO 183 242 ENDIF … … 186 245 ! ... Announce received variables. 187 246 ! 247 srcv(:)%ncplmodel = kcplmodel 248 ! 188 249 DO ji = 1, krcv 189 250 IF ( srcv(ji)%laction ) THEN 251 252 IF( srcv(ji)%nct > nmaxcat ) THEN 253 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// & 254 & TRIM(srcv(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 255 RETURN 256 ENDIF 257 190 258 DO jc = 1, srcv(ji)%nct 191 IF ( srcv(ji)%nct .gt. 1 ) THEN 192 WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc 193 ELSE 194 zclname=srcv(ji)%clname 195 ENDIF 196 WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In 197 CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 198 & PRISM_In , ishape , PRISM_REAL, nerror) 199 IF ( nerror /= PRISM_Ok ) THEN 200 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 201 CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 202 ENDIF 259 DO jm = 1, kcplmodel 260 261 IF ( srcv(ji)%nct .GT. 1 ) THEN 262 WRITE(cli2,'(i2.2)') jc 263 zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2 264 ELSE 265 zclname = srcv(ji)%clname 266 ENDIF 267 IF ( kcplmodel > 1 ) THEN 268 WRITE(cli2,'(i2.2)') jm 269 zclname = 'model'//cli2//'_'//TRIM(zclname) 270 ENDIF 271 #if defined key_agrif 272 IF( agrif_fixed() /= 0 ) THEN 273 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 274 END IF 275 #endif 276 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 277 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 278 & OASIS_In , ishape , OASIS_REAL, nerror ) 279 IF ( nerror /= OASIS_Ok ) THEN 280 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 281 CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 282 ENDIF 283 IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 284 IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 285 286 END DO 203 287 END DO 204 288 ENDIF … … 209 293 !------------------------------------------------------------------ 210 294 211 CALL prism_enddef_proto(nerror)212 IF( nerror /= PRISM_Ok ) CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef')213 ! 214 END SUBROUTINE cpl_ prism_define295 CALL oasis_enddef(nerror) 296 IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 297 ! 298 END SUBROUTINE cpl_define 215 299 216 300 217 SUBROUTINE cpl_ prism_snd( kid, kstep, pdata, kinfo )301 SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo ) 218 302 !!--------------------------------------------------------------------- 219 !! *** ROUTINE cpl_ prism_snd ***303 !! *** ROUTINE cpl_snd *** 220 304 !! 221 305 !! ** Purpose : - At each coupling time-step,this routine sends fields … … 227 311 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata 228 312 !! 229 INTEGER :: jc 313 INTEGER :: jc,jm ! local loop index 230 314 !!-------------------------------------------------------------------- 231 315 ! … … 233 317 ! 234 318 DO jc = 1, ssnd(kid)%nct 235 236 CALL prism_put_proto ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 237 238 IF ( ln_ctl ) THEN 239 IF ( kinfo == PRISM_Sent .OR. kinfo == PRISM_ToRest .OR. & 240 & kinfo == PRISM_SentOut .OR. kinfo == PRISM_ToRestOut ) THEN 241 WRITE(numout,*) '****************' 242 WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 243 WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid(jc) 244 WRITE(numout,*) 'prism_put_proto: kstep ', kstep 245 WRITE(numout,*) 'prism_put_proto: info ', kinfo 246 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 247 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 248 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 249 WRITE(numout,*) '****************' 319 DO jm = 1, ssnd(kid)%ncplmodel 320 321 IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN 322 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 323 324 IF ( ln_ctl ) THEN 325 IF ( kinfo == OASIS_Sent .OR. kinfo == OASIS_ToRest .OR. & 326 & kinfo == OASIS_SentOut .OR. kinfo == OASIS_ToRestOut ) THEN 327 WRITE(numout,*) '****************' 328 WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname 329 WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc,jm) 330 WRITE(numout,*) 'oasis_put: kstep ', kstep 331 WRITE(numout,*) 'oasis_put: info ', kinfo 332 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 333 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 334 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 335 WRITE(numout,*) '****************' 336 ENDIF 337 ENDIF 338 250 339 ENDIF 251 ENDIF252 340 341 ENDDO 253 342 ENDDO 254 343 ! 255 END SUBROUTINE cpl_ prism_snd256 257 258 SUBROUTINE cpl_ prism_rcv( kid, kstep, pdata, kinfo )344 END SUBROUTINE cpl_snd 345 346 347 SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo ) 259 348 !!--------------------------------------------------------------------- 260 !! *** ROUTINE cpl_ prism_rcv ***349 !! *** ROUTINE cpl_rcv *** 261 350 !! 262 351 !! ** Purpose : - At each coupling time-step,this routine receives fields … … 266 355 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 267 356 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done 357 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pmask ! coupling mask 268 358 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 269 359 !! 270 INTEGER :: jc 271 LOGICAL :: llaction 360 INTEGER :: jc,jm ! local loop index 361 LOGICAL :: llaction, llfisrt 272 362 !!-------------------------------------------------------------------- 273 363 ! 274 364 ! receive local data from OASIS3 on every process 275 365 ! 366 kinfo = OASIS_idle 367 ! 276 368 DO jc = 1, srcv(kid)%nct 277 278 CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo ) 279 280 llaction = .false. 281 IF( kinfo == PRISM_Recvd .OR. kinfo == PRISM_FromRest .OR. & 282 kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut ) llaction = .TRUE. 283 284 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc) 285 286 IF ( llaction ) THEN 287 288 kinfo = OASIS_Rcv 289 pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 290 291 !--- Fill the overlap areas and extra hallows (mpp) 292 !--- check periodicity conditions (all cases) 293 CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 294 295 IF ( ln_ctl ) THEN 296 WRITE(numout,*) '****************' 297 WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 298 WRITE(numout,*) 'prism_get_proto: ivarid ' , srcv(kid)%nid(jc) 299 WRITE(numout,*) 'prism_get_proto: kstep', kstep 300 WRITE(numout,*) 'prism_get_proto: info ', kinfo 301 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 302 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 303 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 304 WRITE(numout,*) '****************' 369 llfisrt = .TRUE. 370 371 DO jm = 1, srcv(kid)%ncplmodel 372 373 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 374 375 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 376 377 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 378 & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 379 380 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 381 382 IF ( llaction ) THEN 383 384 kinfo = OASIS_Rcv 385 IF( llfisrt ) THEN 386 pdata(nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 387 llfisrt = .FALSE. 388 ELSE 389 pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 390 ENDIF 391 392 IF ( ln_ctl ) THEN 393 WRITE(numout,*) '****************' 394 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 395 WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc,jm) 396 WRITE(numout,*) 'oasis_get: kstep', kstep 397 WRITE(numout,*) 'oasis_get: info ', kinfo 398 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 399 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 400 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 401 WRITE(numout,*) '****************' 402 ENDIF 403 404 ENDIF 405 305 406 ENDIF 306 407 307 ELSE 308 kinfo = OASIS_idle 309 ENDIF 310 408 ENDDO 409 410 !--- Fill the overlap areas and extra hallows (mpp) 411 !--- check periodicity conditions (all cases) 412 IF( .not. llfisrt ) CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 413 311 414 ENDDO 312 415 ! 313 END SUBROUTINE cpl_ prism_rcv314 315 316 INTEGER FUNCTION cpl_ prism_freq( kid)416 END SUBROUTINE cpl_rcv 417 418 419 INTEGER FUNCTION cpl_freq( cdfieldname ) 317 420 !!--------------------------------------------------------------------- 318 !! *** ROUTINE cpl_ prism_freq ***421 !! *** ROUTINE cpl_freq *** 319 422 !! 320 423 !! ** Purpose : - send back the coupling frequency for a particular field 321 424 !!---------------------------------------------------------------------- 322 INTEGER,INTENT(in) :: kid ! variable index 425 CHARACTER(len = *), INTENT(in) :: cdfieldname ! field name as set in namcouple file 426 !! 427 INTEGER :: id 428 INTEGER :: info 429 INTEGER, DIMENSION(1) :: itmp 430 INTEGER :: ji,jm ! local loop index 431 INTEGER :: mop 323 432 !!---------------------------------------------------------------------- 324 cpl_prism_freq = ig_def_freq( kid ) 325 ! 326 END FUNCTION cpl_prism_freq 327 328 329 SUBROUTINE cpl_prism_finalize 433 cpl_freq = 0 ! defaut definition 434 id = -1 ! defaut definition 435 ! 436 DO ji = 1, nsnd 437 IF (ssnd(ji)%laction ) THEN 438 DO jm = 1, ncplmodel 439 IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN 440 IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN 441 id = ssnd(ji)%nid(1,jm) 442 mop = OASIS_Out 443 ENDIF 444 ENDIF 445 ENDDO 446 ENDIF 447 ENDDO 448 DO ji = 1, nrcv 449 IF (srcv(ji)%laction ) THEN 450 DO jm = 1, ncplmodel 451 IF( srcv(ji)%nid(1,jm) /= -1 ) THEN 452 IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN 453 id = srcv(ji)%nid(1,jm) 454 mop = OASIS_In 455 ENDIF 456 ENDIF 457 ENDDO 458 ENDIF 459 ENDDO 460 ! 461 IF( id /= -1 ) THEN 462 #if defined key_oa3mct_v3 463 CALL oasis_get_freqs(id, mop, 1, itmp, info) 464 #else 465 CALL oasis_get_freqs(id, 1, itmp, info) 466 #endif 467 cpl_freq = itmp(1) 468 ENDIF 469 ! 470 END FUNCTION cpl_freq 471 472 473 SUBROUTINE cpl_finalize 330 474 !!--------------------------------------------------------------------- 331 !! *** ROUTINE cpl_ prism_finalize ***475 !! *** ROUTINE cpl_finalize *** 332 476 !! 333 477 !! ** Purpose : - Finalizes the coupling. If MPI_init has not been 334 !! called explicitly before cpl_ prism_init it will also close478 !! called explicitly before cpl_init it will also close 335 479 !! MPI communication. 336 480 !!---------------------------------------------------------------------- 337 481 ! 338 482 DEALLOCATE( exfld ) 339 CALL prism_terminate_proto( nerror ) 340 ! 341 END SUBROUTINE cpl_prism_finalize 342 343 #else 344 !!---------------------------------------------------------------------- 345 !! Default case Dummy module Forced Ocean/Atmosphere 346 !!---------------------------------------------------------------------- 347 USE in_out_manager ! I/O manager 348 LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE. !: coupled flag 349 PUBLIC cpl_prism_init 350 PUBLIC cpl_prism_finalize 351 CONTAINS 352 SUBROUTINE cpl_prism_init (kl_comm) 353 INTEGER, INTENT(out) :: kl_comm ! local communicator of the model 354 kl_comm = -1 355 WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...' 356 END SUBROUTINE cpl_prism_init 357 SUBROUTINE cpl_prism_finalize 358 WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...' 359 END SUBROUTINE cpl_prism_finalize 483 IF (nstop == 0) THEN 484 CALL oasis_terminate( nerror ) 485 ELSE 486 CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" ) 487 ENDIF 488 ! 489 END SUBROUTINE cpl_finalize 490 491 #if ! defined key_oasis3 492 493 !!---------------------------------------------------------------------- 494 !! No OASIS Library OASIS3 Dummy module... 495 !!---------------------------------------------------------------------- 496 497 SUBROUTINE oasis_init_comp(k1,cd1,k2) 498 CHARACTER(*), INTENT(in ) :: cd1 499 INTEGER , INTENT( out) :: k1,k2 500 k1 = -1 ; k2 = -1 501 WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1 502 END SUBROUTINE oasis_init_comp 503 504 SUBROUTINE oasis_abort(k1,cd1,cd2) 505 INTEGER , INTENT(in ) :: k1 506 CHARACTER(*), INTENT(in ) :: cd1,cd2 507 WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2 508 END SUBROUTINE oasis_abort 509 510 SUBROUTINE oasis_get_localcomm(k1,k2) 511 INTEGER , INTENT( out) :: k1,k2 512 k1 = -1 ; k2 = -1 513 WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...' 514 END SUBROUTINE oasis_get_localcomm 515 516 SUBROUTINE oasis_def_partition(k1,k2,k3) 517 INTEGER , INTENT( out) :: k1,k3 518 INTEGER , INTENT(in ) :: k2(5) 519 k1 = k2(1) ; k3 = k2(5) 520 WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...' 521 END SUBROUTINE oasis_def_partition 522 523 SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 524 CHARACTER(*), INTENT(in ) :: cd1 525 INTEGER , INTENT(in ) :: k2,k3(2),k4,k5(2,2),k6 526 INTEGER , INTENT( out) :: k1,k7 527 k1 = -1 ; k7 = -1 528 WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1 529 END SUBROUTINE oasis_def_var 530 531 SUBROUTINE oasis_enddef(k1) 532 INTEGER , INTENT( out) :: k1 533 k1 = -1 534 WRITE(numout,*) 'oasis_enddef: Error you sould not be there...' 535 END SUBROUTINE oasis_enddef 536 537 SUBROUTINE oasis_put(k1,k2,p1,k3) 538 REAL(wp), DIMENSION(:,:), INTENT(in ) :: p1 539 INTEGER , INTENT(in ) :: k1,k2 540 INTEGER , INTENT( out) :: k3 541 k3 = -1 542 WRITE(numout,*) 'oasis_put: Error you sould not be there...' 543 END SUBROUTINE oasis_put 544 545 SUBROUTINE oasis_get(k1,k2,p1,k3) 546 REAL(wp), DIMENSION(:,:), INTENT( out) :: p1 547 INTEGER , INTENT(in ) :: k1,k2 548 INTEGER , INTENT( out) :: k3 549 p1(1,1) = -1. ; k3 = -1 550 WRITE(numout,*) 'oasis_get: Error you sould not be there...' 551 END SUBROUTINE oasis_get 552 553 SUBROUTINE oasis_get_freqs(k1,k2,k3,k4) 554 INTEGER , INTENT(in ) :: k1,k2 555 INTEGER, DIMENSION(1), INTENT( out) :: k3 556 INTEGER , INTENT( out) :: k4 557 k3(1) = k1 ; k4 = k2 558 WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...' 559 END SUBROUTINE oasis_get_freqs 560 561 SUBROUTINE oasis_terminate(k1) 562 INTEGER , INTENT( out) :: k1 563 k1 = -1 564 WRITE(numout,*) 'oasis_terminate: Error you sould not be there...' 565 END SUBROUTINE oasis_terminate 566 360 567 #endif 361 568
Note: See TracChangeset
for help on using the changeset viewer.
