- Timestamp:
- 2017-12-19T15:42:23+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r6912_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r6486 r9132 41 41 PUBLIC cpl_freq 42 42 PUBLIC cpl_finalize 43 INTEGER, PUBLIC :: paral(5) ! OASIS3 box partition 43 44 44 45 INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field … … 71 72 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information 72 73 LOGICAL :: laction ! To be coupled or not 73 CHARACTER(len = 8 ):: clname ! Name of the coupling field74 CHARACTER(len = 80) :: clname ! Name of the coupling field 74 75 CHARACTER(len = 1) :: clgrid ! Grid type 75 76 REAL(wp) :: nsgn ! Control of the sign change … … 80 81 81 82 TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd !: Coupling fields 83 TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv_c2n, ssnd_n2c 82 84 83 85 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for receiving … … 137 139 ! 138 140 INTEGER :: id_part 139 141 ! INTEGER :: paral(5) ! OASIS3 box partition 140 142 INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe 141 143 INTEGER :: ji,jc,jm ! local loop indicees … … 145 147 146 148 IF(lwp) WRITE(numout,*) 147 IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmospherecase'149 IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled case' 148 150 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 149 151 IF(lwp) WRITE(numout,*) … … 188 190 paral(4) = nlej-nldj+1 ! local extent in j 189 191 paral(5) = jpiglo ! global extent in x 190 191 192 IF( ln_ctl ) THEN 192 193 WRITE(numout,*) ' multiexchg: paral (1:5)', paral … … 196 197 ENDIF 197 198 198 CALL oasis_def_partition ( id_part, paral, nerror )199 CALL oasis_def_partition ( id_part, paral, nerror, name="oce" ) 199 200 ! 200 201 ! ... Announce send variables. 201 202 ! 202 ssnd(:)%ncplmodel = kcplmodel203 ssnd(:)%ncplmodel = 1 203 204 ! 204 205 DO ji = 1, ksnd … … 238 239 IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 239 240 IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 241 END DO 242 END DO 243 ENDIF 244 245 IF ( ssnd_n2c(ji)%laction ) THEN 246 IF( ssnd_n2c(ji)%nct > nmaxcat ) THEN 247 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// & 248 & TRIM(ssnd_n2c(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 249 RETURN 250 ENDIF 251 DO jc = 1, ssnd_n2c(ji)%nct 252 DO jm = 1, kcplmodel 253 254 IF ( ssnd_n2c(ji)%nct .GT. 1 ) THEN 255 WRITE(cli2,'(i2.2)') jc 256 zclname = TRIM(ssnd_n2c(ji)%clname)//'_cat'//cli2 257 ELSE 258 zclname = ssnd_n2c(ji)%clname 259 ENDIF 260 IF ( kcplmodel > 1 ) THEN 261 WRITE(cli2,'(i2.2)') jm 262 zclname = 'model'//cli2//'_'//TRIM(zclname) 263 ENDIF 264 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out 265 CALL oasis_def_var (ssnd_n2c(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 266 & OASIS_Out , ishape , OASIS_REAL, nerror ) 267 IF ( nerror /= OASIS_Ok ) THEN 268 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 269 CALL oasis_abort ( ssnd_n2c(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 270 ENDIF 271 IF( ln_ctl .AND. ssnd_n2c(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 272 IF( ln_ctl .AND. ssnd_n2c(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 240 273 END DO 241 274 END DO … … 287 320 END DO 288 321 ENDIF 322 323 IF ( srcv_c2n(ji)%laction ) THEN 324 325 IF( srcv_c2n(ji)%nct > nmaxcat ) THEN 326 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// & 327 & TRIM(srcv_c2n(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 328 RETURN 329 ENDIF 330 331 DO jc = 1, srcv_c2n(ji)%nct 332 DO jm = 1, kcplmodel 333 334 IF ( srcv_c2n(ji)%nct .GT. 1 ) THEN 335 WRITE(cli2,'(i2.2)') jc 336 zclname = TRIM(srcv_c2n(ji)%clname)//'_cat'//cli2 337 ELSE 338 zclname = srcv_c2n(ji)%clname 339 ENDIF 340 IF ( kcplmodel > 1 ) THEN 341 WRITE(cli2,'(i2.2)') jm 342 zclname = 'model'//cli2//'_'//TRIM(zclname) 343 ENDIF 344 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 345 CALL oasis_def_var (srcv_c2n(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 346 & OASIS_In , ishape , OASIS_REAL, nerror ) 347 IF ( nerror /= OASIS_Ok ) THEN 348 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 349 CALL oasis_abort ( srcv_c2n(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 350 ENDIF 351 IF( ln_ctl .AND. srcv_c2n(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 352 IF( ln_ctl .AND. srcv_c2n(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 353 END DO 354 END DO 355 ENDIF 289 356 END DO 290 357 … … 293 360 !------------------------------------------------------------------ 294 361 295 296 362 ! CALL oasis_enddef(nerror) 363 ! IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 297 364 ! 298 365 END SUBROUTINE cpl_define … … 430 497 INTEGER :: ji,jm ! local loop index 431 498 INTEGER :: mop 499 INTEGER :: ncpl 432 500 !!---------------------------------------------------------------------- 433 501 cpl_freq = 0 ! defaut definition 434 502 id = -1 ! defaut definition 503 ncpl = 1 435 504 ! 436 505 DO ji = 1, nsnd … … 459 528 ENDDO 460 529 ! 530 531 DO ji = 1, nsnd 532 IF (ssnd_n2c(ji)%laction ) THEN 533 DO jm = 1, 1 534 IF( ssnd_n2c(ji)%nid(1,jm) /= -1 ) THEN 535 IF( TRIM(cdfieldname) == TRIM(ssnd_n2c(ji)%clname) ) THEN 536 id = ssnd_n2c(ji)%nid(1,1) 537 mop = OASIS_Out 538 ncpl = 1 539 ENDIF 540 ENDIF 541 ENDDO 542 ENDIF 543 ENDDO 461 544 IF( id /= -1 ) THEN 462 545 #if defined key_oa3mct_v3 463 CALL oasis_get_freqs(id, mop, 1, itmp, info)546 CALL oasis_get_freqs(id, mop, ncpl, itmp, info) 464 547 #else 465 CALL oasis_get_freqs(id, 1, itmp, info)548 CALL oasis_get_freqs(id, ncpl, itmp, info) 466 549 #endif 467 550 cpl_freq = itmp(1) … … 514 597 END SUBROUTINE oasis_get_localcomm 515 598 516 SUBROUTINE oasis_def_partition(k1,k2,k3 )599 SUBROUTINE oasis_def_partition(k1,k2,k3, name) 517 600 INTEGER , INTENT( out) :: k1,k3 518 601 INTEGER , INTENT(in ) :: k2(5) 602 CHARACTER(len=*), INTENT(IN), OPTIONAL :: name 519 603 k1 = k2(1) ; k3 = k2(5) 520 604 WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...'
Note: See TracChangeset
for help on using the changeset viewer.
