- Timestamp:
- 2020-11-27T17:26:33+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/tickets_icb_1900
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900
- Property svn:externals
-
NEMO/branches/2020/tickets_icb_1900/src/OCE/SBC/cpl_oasis3.F90
r12527 r13899 69 69 INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 70 70 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields 71 LOGICAL, PARAMETER :: ltmp_wapatch = .TRUE. ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define72 INTEGER :: nldi_save, nlei_save73 INTEGER :: nldj_save, nlej_save74 71 75 72 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information … … 148 145 !!-------------------------------------------------------------------- 149 146 150 ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define151 IF( ltmp_wapatch ) THEN152 nldi_save = nldi ; nlei_save = nlei153 nldj_save = nldj ; nlej_save = nlej154 IF( nimpp == 1 ) nldi = 1155 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi156 IF( njmpp == 1 ) nldj = 1157 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj158 ENDIF159 147 IF(lwp) WRITE(numout,*) 160 148 IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case' … … 177 165 ENDIF 178 166 ! 179 ! ... Define the shape for the area that excludes the halo 180 ! For serial configuration (key_mpp_mpi not being active) 181 ! nl* is set to the global values 1 and jp*glo. 167 ! ... Define the shape for the area that excludes the halo as we don't want them to be "seen" by oasis 182 168 ! 183 169 ishape(1) = 1 184 ishape(2) = nlei-nldi+1170 ishape(2) = Ni_0 185 171 ishape(3) = 1 186 ishape(4) = nlej-nldj+1172 ishape(4) = Nj_0 187 173 ! 188 174 ! ... Allocate memory for data exchange 189 175 ! 190 ALLOCATE(exfld( nlei-nldi+1, nlej-nldj+1), stat = nerror)176 ALLOCATE(exfld(Ni_0, Nj_0), stat = nerror) ! allocate only inner domain (without halos) 191 177 IF( nerror > 0 ) THEN 192 178 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN … … 194 180 ! 195 181 ! ----------------------------------------------------------------- 196 ! ... Define the partition 182 ! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis 197 183 ! ----------------------------------------------------------------- 198 184 199 paral(1) = 2 200 paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1) ! NEMO lower left corner global offset201 paral(3) = nlei-nldi+1 ! local extent in i202 paral(4) = nlej-nldj+1 ! local extent in j203 paral(5) = jpiglo ! global extent in x185 paral(1) = 2 ! box partitioning 186 paral(2) = Ni0glo * mjg0(nn_hls) + mig0(nn_hls) ! NEMO lower left corner global offset, without halos 187 paral(3) = Ni_0 ! local extent in i, excluding halos 188 paral(4) = Nj_0 ! local extent in j, excluding halos 189 paral(5) = Ni0glo ! global extent in x, excluding halos 204 190 205 191 IF( sn_cfctl%l_oasout ) THEN 206 192 WRITE(numout,*) ' multiexchg: paral (1:5)', paral 207 WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj208 WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp209 WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp193 WRITE(numout,*) ' multiexchg: Ni_0, Nj_0 =', Ni_0, Nj_0 194 WRITE(numout,*) ' multiexchg: Nis0, Nie0, nimpp =', Nis0, Nie0, nimpp 195 WRITE(numout,*) ' multiexchg: Njs0, Nje0, njmpp =', Njs0, Nje0, njmpp 210 196 ENDIF 211 197 212 CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo )198 CALL oasis_def_partition ( id_part, paral, nerror, Ni0glo*Nj0glo ) ! global number of points, excluding halos 213 199 ! 214 200 ! ... Announce send variables. … … 316 302 #endif 317 303 ! 318 IF( ltmp_wapatch ) THEN319 nldi = nldi_save ; nlei = nlei_save320 nldj = nldj_save ; nlej = nlej_save321 ENDIF322 304 END SUBROUTINE cpl_define 323 305 … … 337 319 INTEGER :: jc,jm ! local loop index 338 320 !!-------------------------------------------------------------------- 339 ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define340 IF( ltmp_wapatch ) THEN341 nldi_save = nldi ; nlei_save = nlei342 nldj_save = nldj ; nlej_save = nlej343 IF( nimpp == 1 ) nldi = 1344 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi345 IF( njmpp == 1 ) nldj = 1346 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj347 ENDIF348 321 ! 349 322 ! snd data to OASIS3 … … 352 325 DO jm = 1, ssnd(kid)%ncplmodel 353 326 354 IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN 355 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata( nldi:nlei, nldj:nlej,jc), kinfo )327 IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN ! exclude halos from data sent to oasis 328 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(Nis0:Nie0, Njs0:Nje0,jc), kinfo ) 356 329 357 330 IF ( sn_cfctl%l_oasout ) THEN … … 363 336 WRITE(numout,*) 'oasis_put: kstep ', kstep 364 337 WRITE(numout,*) 'oasis_put: info ', kinfo 365 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata( nldi:nlei,nldj:nlej,jc))366 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata( nldi:nlei,nldj:nlej,jc))367 WRITE(numout,*) ' - Sum value is ', SUM(pdata( nldi:nlei,nldj:nlej,jc))338 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 339 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 340 WRITE(numout,*) ' - Sum value is ', SUM(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 368 341 WRITE(numout,*) '****************' 369 342 ENDIF … … 374 347 ENDDO 375 348 ENDDO 376 IF( ltmp_wapatch ) THEN377 nldi = nldi_save ; nlei = nlei_save378 nldj = nldj_save ; nlej = nlej_save379 ENDIF380 349 ! 381 350 END SUBROUTINE cpl_snd … … 396 365 !! 397 366 INTEGER :: jc,jm ! local loop index 398 LOGICAL :: llaction, ll fisrt367 LOGICAL :: llaction, ll_1st 399 368 !!-------------------------------------------------------------------- 400 ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define401 IF( ltmp_wapatch ) THEN402 nldi_save = nldi ; nlei_save = nlei403 nldj_save = nldj ; nlej_save = nlej404 ENDIF405 369 ! 406 370 ! receive local data from OASIS3 on every process … … 409 373 ! 410 374 DO jc = 1, srcv(kid)%nct 411 IF( ltmp_wapatch ) THEN 412 IF( nimpp == 1 ) nldi = 1 413 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 414 IF( njmpp == 1 ) nldj = 1 415 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 416 ENDIF 417 llfisrt = .TRUE. 375 ll_1st = .TRUE. 418 376 419 377 DO jm = 1, srcv(kid)%ncplmodel … … 426 384 & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 427 385 428 IF ( sn_cfctl%l_oasout ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 386 IF ( sn_cfctl%l_oasout ) & 387 & WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 429 388 430 IF( llaction ) THEN 389 IF( llaction ) THEN ! data received from oasis do not include halos 431 390 432 391 kinfo = OASIS_Rcv 433 IF( ll fisrt ) THEN434 pdata( nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)435 ll fisrt = .FALSE.392 IF( ll_1st ) THEN 393 pdata(Nis0:Nie0,Njs0:Nje0,jc) = exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 394 ll_1st = .FALSE. 436 395 ELSE 437 pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 396 pdata(Nis0:Nie0,Njs0:Nje0,jc) = pdata(Nis0:Nie0,Njs0:Nje0,jc) & 397 & + exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 438 398 ENDIF 439 399 … … 444 404 WRITE(numout,*) 'oasis_get: kstep', kstep 445 405 WRITE(numout,*) 'oasis_get: info ', kinfo 446 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata( nldi:nlei,nldj:nlej,jc))447 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata( nldi:nlei,nldj:nlej,jc))448 WRITE(numout,*) ' - Sum value is ', SUM(pdata( nldi:nlei,nldj:nlej,jc))406 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 407 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 408 WRITE(numout,*) ' - Sum value is ', SUM(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 449 409 WRITE(numout,*) '****************' 450 410 ENDIF … … 456 416 ENDDO 457 417 458 IF( ltmp_wapatch ) THEN 459 nldi = nldi_save ; nlei = nlei_save 460 nldj = nldj_save ; nlej = nlej_save 461 ENDIF 462 !--- Fill the overlap areas and extra hallows (mpp) 463 !--- check periodicity conditions (all cases) 464 IF( .not. llfisrt ) THEN 418 !--- we must call lbc_lnk to fill the halos that where not received. 419 IF( .NOT. ll_1st ) THEN 465 420 CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 466 421 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.