Changeset 12807 for NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/cpl_oasis3.F90
- Timestamp:
- 2020-04-23T15:14:45+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/cpl_oasis3.F90
r12527 r12807 70 70 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields 71 71 LOGICAL, PARAMETER :: ltmp_wapatch = .TRUE. ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 72 INTEGER :: nldi_save, nlei_save73 INTEGER :: nldj_save, nlej_save72 INTEGER :: Nis0_save, Nie0_save 73 INTEGER :: Njs0_save, Nje0_save 74 74 75 75 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information … … 150 150 ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 151 151 IF( ltmp_wapatch ) THEN 152 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= jpj152 Nis0_save = Nis0 ; Nie0_save = Nie0 153 Njs0_save = Njs0 ; Nje0_save = Nje0 154 IF( nimpp == 1 ) Nis0 = 1 155 IF( nimpp + jpi - 1 == jpiglo ) Nie0 = jpi 156 IF( njmpp == 1 ) Njs0 = 1 157 IF( njmpp + jpj - 1 == jpjglo ) Nje0 = jpj 158 158 ENDIF 159 159 IF(lwp) WRITE(numout,*) … … 182 182 ! 183 183 ishape(1) = 1 184 ishape(2) = nlei-nldi+1184 ishape(2) = Ni_0 185 185 ishape(3) = 1 186 ishape(4) = nlej-nldj+1186 ishape(4) = Nj_0 187 187 ! 188 188 ! ... Allocate memory for data exchange 189 189 ! 190 ALLOCATE(exfld( nlei-nldi+1, nlej-nldj+1), stat = nerror)190 ALLOCATE(exfld(Ni_0, Nj_0), stat = nerror) 191 191 IF( nerror > 0 ) THEN 192 192 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN … … 198 198 199 199 paral(1) = 2 ! box partitioning 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 j200 paral(2) = jpiglo * (Njs0-1+njmpp-1) + (Nis0-1+nimpp-1) ! NEMO lower left corner global offset 201 paral(3) = Ni_0 ! local extent in i 202 paral(4) = Nj_0 ! local extent in j 203 203 paral(5) = jpiglo ! global extent in x 204 204 … … 206 206 WRITE(numout,*) ' multiexchg: paral (1:5)', paral 207 207 WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj 208 WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp209 WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp208 WRITE(numout,*) ' multiexchg: Nis0, Nie0, nimpp =', Nis0, Nie0, nimpp 209 WRITE(numout,*) ' multiexchg: Njs0, Nje0, njmpp =', Njs0, Nje0, njmpp 210 210 ENDIF 211 211 … … 317 317 ! 318 318 IF( ltmp_wapatch ) THEN 319 nldi = nldi_save ; nlei = nlei_save320 nldj = nldj_save ; nlej = nlej_save319 Nis0 = Nis0_save ; Nie0 = Nie0_save 320 Njs0 = Njs0_save ; Nje0 = Nje0_save 321 321 ENDIF 322 322 END SUBROUTINE cpl_define … … 339 339 ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 340 340 IF( ltmp_wapatch ) THEN 341 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= jpj341 Nis0_save = Nis0 ; Nie0_save = Nie0 342 Njs0_save = Njs0 ; Nje0_save = Nje0 343 IF( nimpp == 1 ) Nis0 = 1 344 IF( nimpp + jpi - 1 == jpiglo ) Nie0 = jpi 345 IF( njmpp == 1 ) Njs0 = 1 346 IF( njmpp + jpj - 1 == jpjglo ) Nje0 = jpj 347 347 ENDIF 348 348 ! … … 353 353 354 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 )355 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(Nis0:Nie0, Njs0:Nje0,jc), kinfo ) 356 356 357 357 IF ( sn_cfctl%l_oasout ) THEN … … 363 363 WRITE(numout,*) 'oasis_put: kstep ', kstep 364 364 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))365 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 366 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 367 WRITE(numout,*) ' - Sum value is ', SUM(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 368 368 WRITE(numout,*) '****************' 369 369 ENDIF … … 375 375 ENDDO 376 376 IF( ltmp_wapatch ) THEN 377 nldi = nldi_save ; nlei = nlei_save378 nldj = nldj_save ; nlej = nlej_save377 Nis0 = Nis0_save ; Nie0 = Nie0_save 378 Njs0 = Njs0_save ; Nje0 = Nje0_save 379 379 ENDIF 380 380 ! … … 400 400 ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 401 401 IF( ltmp_wapatch ) THEN 402 nldi_save = nldi ; nlei_save = nlei403 nldj_save = nldj ; nlej_save = nlej402 Nis0_save = Nis0 ; Nie0_save = Nie0 403 Njs0_save = Njs0 ; Nje0_save = Nje0 404 404 ENDIF 405 405 ! … … 410 410 DO jc = 1, srcv(kid)%nct 411 411 IF( ltmp_wapatch ) THEN 412 IF( nimpp == 1 ) nldi= 1413 IF( nimpp + jpi - 1 == jpiglo ) nlei= jpi414 IF( njmpp == 1 ) nldj= 1415 IF( njmpp + jpj - 1 == jpjglo ) nlej= jpj412 IF( nimpp == 1 ) Nis0 = 1 413 IF( nimpp + jpi - 1 == jpiglo ) Nie0 = jpi 414 IF( njmpp == 1 ) Njs0 = 1 415 IF( njmpp + jpj - 1 == jpjglo ) Nje0 = jpj 416 416 ENDIF 417 417 llfisrt = .TRUE. … … 432 432 kinfo = OASIS_Rcv 433 433 IF( llfisrt ) THEN 434 pdata( nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)434 pdata(Nis0:Nie0,Njs0:Nje0,jc) = exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 435 435 llfisrt = .FALSE. 436 436 ELSE 437 pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 437 pdata(Nis0:Nie0,Njs0:Nje0,jc) = pdata(Nis0:Nie0,Njs0:Nje0,jc) & 438 & + exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 438 439 ENDIF 439 440 … … 444 445 WRITE(numout,*) 'oasis_get: kstep', kstep 445 446 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))447 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 448 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 449 WRITE(numout,*) ' - Sum value is ', SUM(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 449 450 WRITE(numout,*) '****************' 450 451 ENDIF … … 457 458 458 459 IF( ltmp_wapatch ) THEN 459 nldi = nldi_save ; nlei = nlei_save460 nldj = nldj_save ; nlej = nlej_save460 Nis0 = Nis0_save ; Nie0 = Nie0_save 461 Njs0 = Njs0_save ; Nje0 = Nje0_save 461 462 ENDIF 462 463 !--- Fill the overlap areas and extra hallows (mpp)
Note: See TracChangeset
for help on using the changeset viewer.
