Changeset 6346 for CONFIG/UNIFORM/v7/IPSLCM7/SOURCES/NEMO/cpl_oasis3.F90
- Timestamp:
- 03/21/23 14:42:28 (16 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
CONFIG/UNIFORM/v7/IPSLCM7/SOURCES/NEMO/cpl_oasis3.F90
r6329 r6346 1 2 1 MODULE cpl_oasis3 3 2 !!====================================================================== … … 5 4 !! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT 6 5 !!===================================================================== 7 !! History : 8 !! 9.0 ! 04-06 (R. Redler, NEC Laboratories Europe, Germany) Original code 9 !! " " ! 04-11 (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision 10 !! " " ! 04-11 (V. Gayler, MPI M&D) Grid writing 11 !! " " ! 05-08 (R. Redler, W. Park) frld initialization, paral(2) revision 12 !! " " ! 05-09 (R. Redler) extended to allow for communication over root only 13 !! " " ! 06-01 (W. Park) modification of physical part 14 !! " " ! 06-02 (R. Redler, W. Park) buffer array fix for root exchange 15 !! 3.4 ! 11-11 (C. Harris) Changes to allow mutiple category fields 16 !!---------------------------------------------------------------------- 6 !! History : 1.0 ! 2004-06 (R. Redler, NEC Laboratories Europe, Germany) Original code 7 !! - ! 2004-11 (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision 8 !! - ! 2004-11 (V. Gayler, MPI M&D) Grid writing 9 !! 2.0 ! 2005-08 (R. Redler, W. Park) frld initialization, paral(2) revision 10 !! - ! 2005-09 (R. Redler) extended to allow for communication over root only 11 !! - ! 2006-01 (W. Park) modification of physical part 12 !! - ! 2006-02 (R. Redler, W. Park) buffer array fix for root exchange 13 !! 3.4 ! 2011-11 (C. Harris) Changes to allow mutiple category fields 14 !! 3.6 ! 2014-11 (S. Masson) OASIS3-MCT 15 !!---------------------------------------------------------------------- 16 17 17 !!---------------------------------------------------------------------- 18 18 !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3-MCT … … 21 21 !! cpl_init : initialization of coupled mode communication 22 22 !! cpl_define : definition of grid and fields 23 !! cpl_snd : snd out fields in coupled mode24 !! cpl_rcv : receive fields in coupled mode23 !! cpl_snd : snd out fields in coupled mode 24 !! cpl_rcv : receive fields in coupled mode 25 25 !! cpl_finalize : finalize the coupled mode communication 26 26 !!---------------------------------------------------------------------- … … 64 64 #endif 65 65 66 INTEGER :: nrcv ! total number of fields received 67 INTEGER :: nsnd ! total number of fields sent 66 INTEGER :: nrcv ! total number of fields received 67 INTEGER :: nsnd ! total number of fields sent 68 68 INTEGER :: ncplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 69 INTEGER, PUBLIC, PARAMETER :: nmaxfld= 50! Maximum number of coupling fields69 INTEGER, PUBLIC, PARAMETER :: nmaxfld=62 ! Maximum number of coupling fields 70 70 INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 71 71 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields 72 72 73 73 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information 74 74 LOGICAL :: laction ! To be coupled or not 75 CHARACTER(len = 8) :: clname ! Name of the coupling field 76 CHARACTER(len = 1) :: clgrid ! Grid type 75 CHARACTER(len = 8) :: clname ! Name of the coupling field 76 CHARACTER(len = 1) :: clgrid ! Grid type 77 77 REAL(wp) :: nsgn ! Control of the sign change 78 78 INTEGER, DIMENSION(nmaxcat,nmaxcpl) :: nid ! Id of the field (no more than 9 categories and 9 extrena models) … … 86 86 87 87 !!---------------------------------------------------------------------- 88 !! NEMO/O PA 3.3 , NEMO Consortium (2010)89 !! $Id: cpl_oasis3.F90 7846 2017-03-30 13:25:01Z cetlod$90 !! Software governed by the CeCILL licen ce (NEMOGCM/NEMO_CeCILL.txt)88 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 89 !! $Id: cpl_oasis3.F90 14434 2021-02-11 08:20:52Z smasson $ 90 !! Software governed by the CeCILL license (see ./LICENSE) 91 91 !!---------------------------------------------------------------------- 92 92 CONTAINS … … 99 99 !! exchange between AGCM, OGCM and COUPLER. (OASIS3 software) 100 100 !! 101 !! ** Method : OASIS3 MPI communication 101 !! ** Method : OASIS3 MPI communication 102 102 !!-------------------------------------------------------------------- 103 CHARACTER(len = *), INTENT(in ) :: cd_modname ! model name as set in namcouple file104 INTEGER , INTENT(out) :: kl_comm ! local communicator of the model103 CHARACTER(len = *), INTENT(in ) :: cd_modname ! model name as set in namcouple file 104 INTEGER , INTENT( out) :: kl_comm ! local communicator of the model 105 105 !!-------------------------------------------------------------------- 106 106 … … 112 112 !------------------------------------------------------------------ 113 113 CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror ) 114 IF 114 IF( nerror /= OASIS_Ok ) & 115 115 CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') 116 116 117 117 !------------------------------------------------------------------ 118 ! 3rd Get an MPI communicator for O PAlocal communication118 ! 3rd Get an MPI communicator for OCE local communication 119 119 !------------------------------------------------------------------ 120 120 121 121 CALL oasis_get_localcomm ( kl_comm, nerror ) 122 IF 122 IF( nerror /= OASIS_Ok ) & 123 123 CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 124 124 ! … … 133 133 !! exchange between AGCM, OGCM and COUPLER. (OASIS3 software) 134 134 !! 135 !! ** Method : OASIS3 MPI communication 135 !! ** Method : OASIS3 MPI communication 136 136 !!-------------------------------------------------------------------- 137 137 INTEGER, INTENT(in) :: krcv, ksnd ! Number of received and sent coupling fields … … 140 140 INTEGER :: id_part 141 141 INTEGER :: paral(5) ! OASIS3 box partition 142 INTEGER :: ishape( 2,2) ! shape of arrays passed to PSMILe142 INTEGER :: ishape(4) ! shape of arrays passed to PSMILe 143 143 INTEGER :: ji,jc,jm ! local loop indicees 144 144 CHARACTER(LEN=64) :: zclname … … 165 165 CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld') ; RETURN 166 166 ENDIF 167 168 ! 169 ! ... Define the shape for the area that excludes the halo 170 ! For serial configuration (key_mpp_mpi not being active) 171 ! nl* is set to the global values 1 and jp*glo. 172 ! 173 ishape(:,1) = (/ 1, nlei-nldi+1 /) 174 ishape(:,2) = (/ 1, nlej-nldj+1 /) 167 ! 168 ! ... Define the shape for the area that excludes the halo as we don't want them to be "seen" by oasis 169 ! 170 ishape(1) = 1 171 ishape(2) = Ni_0 172 ishape(3) = 1 173 ishape(4) = Nj_0 175 174 ! 176 175 ! ... Allocate memory for data exchange 177 176 ! 178 ALLOCATE(exfld( nlei-nldi+1, nlej-nldj+1), stat = nerror)177 ALLOCATE(exfld(Ni_0, Nj_0), stat = nerror) ! allocate only inner domain (without halos) 179 178 IF( nerror > 0 ) THEN 180 179 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN … … 182 181 ! 183 182 ! ----------------------------------------------------------------- 184 ! ... Define the partition 183 ! ... Define the partition, excluding halos as we don't want them to be "seen" by oasis 185 184 ! ----------------------------------------------------------------- 186 187 paral(1) = 2 188 paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1) ! NEMO lower left corner global offset189 paral(3) = nlei-nldi+1 ! local extent in i190 paral(4) = nlej-nldj+1 ! local extent in j191 paral(5) = jpiglo ! global extent in x192 193 IF( ln_ctl) THEN185 186 paral(1) = 2 ! box partitioning 187 paral(2) = Ni0glo * mjg0(nn_hls) + mig0(nn_hls) ! NEMO lower left corner global offset, without halos 188 paral(3) = Ni_0 ! local extent in i, excluding halos 189 paral(4) = Nj_0 ! local extent in j, excluding halos 190 paral(5) = Ni0glo ! global extent in x, excluding halos 191 192 IF( sn_cfctl%l_oasout ) THEN 194 193 WRITE(numout,*) ' multiexchg: paral (1:5)', paral 195 WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj196 WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp197 WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp198 ENDIF 199 200 CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo )201 ! 202 ! ... Announce send variables. 194 WRITE(numout,*) ' multiexchg: Ni_0, Nj_0 =', Ni_0, Nj_0 195 WRITE(numout,*) ' multiexchg: Nis0, Nie0, nimpp =', Nis0, Nie0, nimpp 196 WRITE(numout,*) ' multiexchg: Njs0, Nje0, njmpp =', Njs0, Nje0, njmpp 197 ENDIF 198 199 CALL oasis_def_partition ( id_part, paral, nerror, Ni0glo*Nj0glo ) ! global number of points, excluding halos 200 ! 201 ! ... Announce send variables. 203 202 ! 204 203 ssnd(:)%ncplmodel = kcplmodel 205 204 ! 206 205 DO ji = 1, ksnd 207 IF 206 IF( ssnd(ji)%laction ) THEN 208 207 209 208 IF( ssnd(ji)%nct > nmaxcat ) THEN … … 212 211 RETURN 213 212 ENDIF 214 213 215 214 DO jc = 1, ssnd(ji)%nct 216 215 DO jm = 1, kcplmodel 217 216 218 IF 217 IF( ssnd(ji)%nct .GT. 1 ) THEN 219 218 WRITE(cli2,'(i2.2)') jc 220 219 zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2 … … 222 221 zclname = ssnd(ji)%clname 223 222 ENDIF 224 IF 223 IF( kcplmodel > 1 ) THEN 225 224 WRITE(cli2,'(i2.2)') jm 226 225 zclname = 'model'//cli2//'_'//TRIM(zclname) 227 226 ENDIF 228 227 #if defined key_agrif 229 IF( agrif_fixed() /= 0 ) THEN 228 IF( agrif_fixed() /= 0 ) THEN 230 229 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 231 END 232 #endif 233 IF( ln_ctl) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out234 CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0/), &235 & OASIS_Out , OASIS_REAL, nerror )236 IF 230 ENDIF 231 #endif 232 IF( sn_cfctl%l_oasout ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out 233 CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part , (/ 2, 1 /), & 234 & OASIS_Out , ishape , OASIS_REAL, nerror ) 235 IF( nerror /= OASIS_Ok ) THEN 237 236 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 238 237 CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 239 238 ENDIF 240 IF( ln_ctl.AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"241 IF( ln_ctl.AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"239 IF( sn_cfctl%l_oasout .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 240 IF( sn_cfctl%l_oasout .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 242 241 END DO 243 242 END DO … … 245 244 END DO 246 245 ! 247 ! ... Announce received variables. 246 ! ... Announce received variables. 248 247 ! 249 248 srcv(:)%ncplmodel = kcplmodel 250 249 ! 251 250 DO ji = 1, krcv 252 IF ( srcv(ji)%laction ) THEN253 251 IF( srcv(ji)%laction ) THEN 252 254 253 IF( srcv(ji)%nct > nmaxcat ) THEN 255 254 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// & … … 257 256 RETURN 258 257 ENDIF 259 258 260 259 DO jc = 1, srcv(ji)%nct 261 260 DO jm = 1, kcplmodel 262 263 IF 261 262 IF( srcv(ji)%nct .GT. 1 ) THEN 264 263 WRITE(cli2,'(i2.2)') jc 265 264 zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2 … … 267 266 zclname = srcv(ji)%clname 268 267 ENDIF 269 IF 268 IF( kcplmodel > 1 ) THEN 270 269 WRITE(cli2,'(i2.2)') jm 271 270 zclname = 'model'//cli2//'_'//TRIM(zclname) 272 271 ENDIF 273 272 #if defined key_agrif 274 IF( agrif_fixed() /= 0 ) THEN 273 IF( agrif_fixed() /= 0 ) THEN 275 274 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 276 END 277 #endif 278 IF( ln_ctl) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In279 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0/), &280 & OASIS_In , OASIS_REAL, nerror )281 IF 275 ENDIF 276 #endif 277 IF( sn_cfctl%l_oasout ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 278 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 1 /), & 279 & OASIS_In , ishape , OASIS_REAL, nerror ) 280 IF( nerror /= OASIS_Ok ) THEN 282 281 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 283 282 CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 284 283 ENDIF 285 IF( ln_ctl.AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple"286 IF( ln_ctl.AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple"284 IF( sn_cfctl%l_oasout .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 285 IF( sn_cfctl%l_oasout .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 287 286 288 287 END DO … … 290 289 ENDIF 291 290 END DO 292 291 293 292 !------------------------------------------------------------------ 294 293 ! End of definition phase 295 294 !------------------------------------------------------------------ 296 295 ! 296 #if defined key_agrif 297 ! Warning: Agrif_Nb_Fine_Grids not yet defined at this stage for Agrif_Root -> must use Agrif_Root_Only() 298 IF( Agrif_Root_Only() .OR. agrif_fixed() == Agrif_Nb_Fine_Grids() ) THEN 299 #endif 297 300 CALL xios_oasis_enddef() 298 301 CALL oasis_enddef(nerror) 299 302 IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 303 #if defined key_agrif 304 ENDIF 305 #endif 300 306 ! 301 307 END SUBROUTINE cpl_define 302 303 308 309 304 310 SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo ) 305 311 !!--------------------------------------------------------------------- … … 321 327 DO jc = 1, ssnd(kid)%nct 322 328 DO jm = 1, ssnd(kid)%ncplmodel 323 324 IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN 325 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata( nldi:nlei, nldj:nlej,jc), kinfo )326 327 IF ( ln_ctl ) THEN329 330 IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN ! exclude halos from data sent to oasis 331 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(Nis0:Nie0, Njs0:Nje0,jc), kinfo ) 332 333 IF ( sn_cfctl%l_oasout ) THEN 328 334 IF ( kinfo == OASIS_Sent .OR. kinfo == OASIS_ToRest .OR. & 329 335 & kinfo == OASIS_SentOut .OR. kinfo == OASIS_ToRestOut ) THEN … … 333 339 WRITE(numout,*) 'oasis_put: kstep ', kstep 334 340 WRITE(numout,*) 'oasis_put: info ', kinfo 335 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata( :,:,jc))336 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata( :,:,jc))337 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc))341 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 342 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 343 WRITE(numout,*) ' - Sum value is ', SUM(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 338 344 WRITE(numout,*) '****************' 339 345 ENDIF 340 346 ENDIF 341 347 342 348 ENDIF 343 349 344 350 ENDDO 345 351 ENDDO … … 362 368 !! 363 369 INTEGER :: jc,jm ! local loop index 364 LOGICAL :: llaction, ll fisrt370 LOGICAL :: llaction, ll_1st 365 371 !!-------------------------------------------------------------------- 366 372 ! … … 370 376 ! 371 377 DO jc = 1, srcv(kid)%nct 372 ll fisrt = .TRUE.378 ll_1st = .TRUE. 373 379 374 380 DO jm = 1, srcv(kid)%ncplmodel … … 376 382 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 377 383 378 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 379 384 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 385 380 386 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 381 387 & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 382 383 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 384 385 IF ( llaction ) THEN 386 388 389 IF ( sn_cfctl%l_oasout ) & 390 & WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 391 392 IF( llaction ) THEN ! data received from oasis do not include halos 393 387 394 kinfo = OASIS_Rcv 388 IF( ll fisrt ) THEN389 pdata( nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)390 ll fisrt = .FALSE.395 IF( ll_1st ) THEN 396 pdata(Nis0:Nie0,Njs0:Nje0,jc) = exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 397 ll_1st = .FALSE. 391 398 ELSE 392 pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 393 ENDIF 394 395 IF ( ln_ctl ) THEN 399 pdata(Nis0:Nie0,Njs0:Nje0,jc) = pdata(Nis0:Nie0,Njs0:Nje0,jc) & 400 & + exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 401 ENDIF 402 403 IF ( sn_cfctl%l_oasout ) THEN 396 404 WRITE(numout,*) '****************' 397 405 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname … … 399 407 WRITE(numout,*) 'oasis_get: kstep', kstep 400 408 WRITE(numout,*) 'oasis_get: info ', kinfo 401 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata( :,:,jc))402 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata( :,:,jc))403 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc))409 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 410 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 411 WRITE(numout,*) ' - Sum value is ', SUM(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 404 412 WRITE(numout,*) '****************' 405 413 ENDIF 406 414 407 415 ENDIF 408 416 409 417 ENDIF 410 418 411 419 ENDDO 412 420 413 !--- Fill the overlap areas and extra hallows (mpp) 414 !--- check periodicity conditions (all cases) 415 IF( .not. llfisrt ) CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 416 421 !--- we must call lbc_lnk to fill the halos that where not received. 422 IF( .NOT. ll_1st ) THEN 423 CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 424 ENDIF 425 417 426 ENDDO 418 427 ! … … 420 429 421 430 422 INTEGER FUNCTION cpl_freq( cdfieldname ) 431 INTEGER FUNCTION cpl_freq( cdfieldname ) 423 432 !!--------------------------------------------------------------------- 424 433 !! *** ROUTINE cpl_freq *** … … 438 447 ! 439 448 DO ji = 1, nsnd 440 IF 449 IF(ssnd(ji)%laction ) THEN 441 450 DO jm = 1, ncplmodel 442 451 IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN … … 450 459 ENDDO 451 460 DO ji = 1, nrcv 452 IF 461 IF(srcv(ji)%laction ) THEN 453 462 DO jm = 1, ncplmodel 454 463 IF( srcv(ji)%nid(1,jm) /= -1 ) THEN … … 463 472 ! 464 473 IF( id /= -1 ) THEN 465 #if defined key_oa3mct_v3466 474 CALL oasis_get_freqs(id, mop, 1, itmp, info) 467 #else468 CALL oasis_get_freqs(id, 1, itmp, info)469 #endif470 475 cpl_freq = itmp(1) 471 476 ENDIF … … 484 489 ! 485 490 DEALLOCATE( exfld ) 486 IF 487 CALL oasis_terminate( nerror ) 491 IF(nstop == 0) THEN 492 CALL oasis_terminate( nerror ) 488 493 ELSE 489 494 CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" ) 490 ENDIF 495 ENDIF 491 496 ! 492 497 END SUBROUTINE cpl_finalize … … 538 543 WRITE(numout,*) 'oasis_enddef: Error you sould not be there...' 539 544 END SUBROUTINE oasis_enddef 540 545 541 546 SUBROUTINE oasis_put(k1,k2,p1,k3) 542 547 REAL(wp), DIMENSION(:,:), INTENT(in ) :: p1 … … 555 560 END SUBROUTINE oasis_get 556 561 557 SUBROUTINE oasis_get_freqs(k1,k 2,k3,k4)562 SUBROUTINE oasis_get_freqs(k1,k5,k2,k3,k4) 558 563 INTEGER , INTENT(in ) :: k1,k2 559 564 INTEGER, DIMENSION(1), INTENT( out) :: k3 560 INTEGER , INTENT( out) :: k4 561 k3(1) = k1 ; k4 = k2 565 INTEGER , INTENT( out) :: k4,k5 566 k3(1) = k1 ; k4 = k2 ; k5 = k2 562 567 WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...' 563 568 END SUBROUTINE oasis_get_freqs … … 568 573 WRITE(numout,*) 'oasis_terminate: Error you sould not be there...' 569 574 END SUBROUTINE oasis_terminate 570 575 571 576 #endif 572 577
Note: See TracChangeset
for help on using the changeset viewer.
