- Timestamp:
- 2014-11-21T09:58:25+01:00 (10 years ago)
- Location:
- branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r4859 r4879 61 61 #endif 62 62 63 INTEGER, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields 63 INTEGER, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields 64 INTEGER, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 65 INTEGER, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields 64 66 65 67 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information … … 68 70 CHARACTER(len = 1) :: clgrid ! Grid type 69 71 REAL(wp) :: nsgn ! Control of the sign change 70 INTEGER, DIMENSION( 9) :: nid ! Id of the field (no more than 9 categories)72 INTEGER, DIMENSION(nmaxcat,nmaxcpl) :: nid ! Id of the field (no more than 9 categories and 9 extrena models) 71 73 INTEGER :: nct ! Number of categories in field 74 INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received 72 75 END TYPE FLD_CPL 73 76 … … 116 119 117 120 118 SUBROUTINE cpl_define( krcv, ksnd )121 SUBROUTINE cpl_define( krcv, ksnd, kcplmodel ) 119 122 !!------------------------------------------------------------------- 120 123 !! *** ROUTINE cpl_define *** … … 126 129 !!-------------------------------------------------------------------- 127 130 INTEGER, INTENT(in) :: krcv, ksnd ! Number of received and sent coupling fields 131 INTEGER, INTENT(in) :: kcplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 128 132 ! 129 133 INTEGER :: id_part 130 134 INTEGER :: paral(5) ! OASIS3 box partition 131 135 INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe 132 INTEGER :: ji,jc ! local loop indicees 133 CHARACTER(LEN=8) :: zclname 136 INTEGER :: ji,jc,jm ! local loop indicees 137 CHARACTER(LEN=64) :: zclname 138 CHARACTER(LEN=2) :: cli2 134 139 !!-------------------------------------------------------------------- 135 140 … … 139 144 IF(lwp) WRITE(numout,*) 140 145 146 IF( kcplmodel > nmaxcpl ) THEN 147 CALL oasis_abort ( ncomp_id, 'cpl_define', 'kcplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN 148 ENDIF 141 149 ! 142 150 ! ... Define the shape for the area that excludes the halo … … 175 183 ! ... Announce send variables. 176 184 ! 185 ssnd(:)%ncplmodel = kcplmodel 186 ! 177 187 DO ji = 1, ksnd 178 IF ( ssnd(ji)%laction ) THEN 188 IF ( ssnd(ji)%laction ) THEN 189 190 IF( ssnd(ji)%nct > nmaxcat ) THEN 191 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// & 192 & TRIM(ssnd(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 193 RETURN 194 ENDIF 195 179 196 DO jc = 1, ssnd(ji)%nct 180 IF ( ssnd(ji)%nct .gt. 1 ) THEN 181 WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc 182 ELSE 183 zclname=ssnd(ji)%clname 184 ENDIF 185 WRITE(numout,*) "Define",ji,jc,zclname," for",OASIS_Out 186 CALL oasis_def_var (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 187 OASIS_Out, ishape, OASIS_REAL, nerror) 188 IF ( nerror /= OASIS_Ok ) THEN 189 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 190 CALL oasis_abort ( ssnd(ji)%nid(jc), 'cpl_define', 'Failure in oasis_def_var') 191 ENDIF 197 DO jm = 1, kcplmodel 198 199 IF ( ssnd(ji)%nct .GT. 1 ) THEN 200 WRITE(cli2,'(i2.2)') jc 201 zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2 202 ELSE 203 zclname = ssnd(ji)%clname 204 ENDIF 205 IF ( kcplmodel > 1 ) THEN 206 WRITE(cli2,'(i2.2)') jm 207 zclname = 'model'//cli2//'_'//TRIM(zclname) 208 ENDIF 209 #if defined key_agrif 210 IF( agrif_fixed() /= 0 ) THEN 211 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 212 END IF 213 #endif 214 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out 215 CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 216 & OASIS_Out , ishape , OASIS_REAL, nerror ) 217 IF ( nerror /= OASIS_Ok ) THEN 218 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 219 CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 220 ENDIF 221 IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 222 IF( ln_ctl .AND. ssnd(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 223 END DO 192 224 END DO 193 225 ENDIF … … 198 230 DO ji = 1, krcv 199 231 IF ( srcv(ji)%laction ) THEN 232 233 IF( srcv(ji)%nct > nmaxcat ) THEN 234 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Number of categories of '// & 235 & TRIM(srcv(ji)%clname)//' is larger than nmaxcat, increase nmaxcat' ) 236 RETURN 237 ENDIF 238 200 239 DO jc = 1, srcv(ji)%nct 201 IF ( srcv(ji)%nct .gt. 1 ) THEN 202 WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc 203 ELSE 204 zclname=srcv(ji)%clname 205 ENDIF 206 WRITE(numout,*) "Define",ji,jc,zclname," for",OASIS_In 207 CALL oasis_def_var ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 208 & OASIS_In , ishape , OASIS_REAL, nerror) 209 IF ( nerror /= OASIS_Ok ) THEN 210 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 211 CALL oasis_abort ( srcv(ji)%nid(jc), 'cpl_define', 'Failure in oasis_def_var') 212 ENDIF 240 DO jm = 1, kcplmodel 241 242 IF ( srcv(ji)%nct .GT. 1 ) THEN 243 WRITE(cli2,'(i2.2)') jc 244 zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2 245 ELSE 246 zclname = srcv(ji)%clname 247 ENDIF 248 IF ( kcplmodel > 1 ) THEN 249 WRITE(cli2,'(i2.2)') jm 250 zclname = 'model'//cli2//'_'//TRIM(zclname) 251 ENDIF 252 #if defined key_agrif 253 IF( agrif_fixed() /= 0 ) THEN 254 zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 255 END IF 256 #endif 257 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 258 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 259 & OASIS_In , ishape , OASIS_REAL, nerror ) 260 IF ( nerror /= OASIS_Ok ) THEN 261 WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 262 CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 263 ENDIF 264 IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) /= -1 ) WRITE(numout,*) "variable defined in the namcouple" 265 IF( ln_ctl .AND. srcv(ji)%nid(jc,jm) == -1 ) WRITE(numout,*) "variable NOT defined in the namcouple" 266 267 END DO 213 268 END DO 214 269 ENDIF … … 237 292 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata 238 293 !! 239 INTEGER :: jc 294 INTEGER :: jc,jm ! local loop index 240 295 !!-------------------------------------------------------------------- 241 296 ! … … 243 298 ! 244 299 DO jc = 1, ssnd(kid)%nct 245 246 CALL oasis_put ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 247 248 IF ( ln_ctl ) THEN 249 IF ( kinfo == OASIS_Sent .OR. kinfo == OASIS_ToRest .OR. & 250 & kinfo == OASIS_SentOut .OR. kinfo == OASIS_ToRestOut ) THEN 251 WRITE(numout,*) '****************' 252 WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname 253 WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc) 254 WRITE(numout,*) 'oasis_put: kstep ', kstep 255 WRITE(numout,*) 'oasis_put: info ', kinfo 256 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 257 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 258 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 259 WRITE(numout,*) '****************' 300 DO jm = 1, ssnd(kid)%ncplmodel 301 302 IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN 303 CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 304 305 IF ( ln_ctl ) THEN 306 IF ( kinfo == OASIS_Sent .OR. kinfo == OASIS_ToRest .OR. & 307 & kinfo == OASIS_SentOut .OR. kinfo == OASIS_ToRestOut ) THEN 308 WRITE(numout,*) '****************' 309 WRITE(numout,*) 'oasis_put: Outgoing ', ssnd(kid)%clname 310 WRITE(numout,*) 'oasis_put: ivarid ', ssnd(kid)%nid(jc,jm) 311 WRITE(numout,*) 'oasis_put: kstep ', kstep 312 WRITE(numout,*) 'oasis_put: info ', kinfo 313 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 314 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 315 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 316 WRITE(numout,*) '****************' 317 ENDIF 318 ENDIF 319 260 320 ENDIF 261 ENDIF262 321 322 ENDDO 263 323 ENDDO 264 324 ! … … 266 326 267 327 268 SUBROUTINE cpl_rcv( kid, kstep, pdata, kinfo )328 SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo ) 269 329 !!--------------------------------------------------------------------- 270 330 !! *** ROUTINE cpl_rcv *** … … 276 336 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 277 337 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pdata ! IN to keep the value if nothing is done 338 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pmask ! coupling mask 278 339 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 279 340 !! 280 INTEGER :: jc 281 LOGICAL :: llaction 341 INTEGER :: jc,jm ! local loop index 342 LOGICAL :: llaction, llfisrt 282 343 !!-------------------------------------------------------------------- 283 344 ! 284 345 ! receive local data from OASIS3 on every process 285 346 ! 347 kinfo = OASIS_idle 348 ! 286 349 DO jc = 1, srcv(kid)%nct 287 288 CALL oasis_get ( srcv(kid)%nid(jc), kstep, exfld, kinfo ) 289 290 llaction = .false. 291 IF( kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 292 kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut ) llaction = .TRUE. 293 294 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc) 295 296 IF ( llaction ) THEN 297 298 kinfo = OASIS_Rcv 299 pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 300 301 !--- Fill the overlap areas and extra hallows (mpp) 302 !--- check periodicity conditions (all cases) 303 CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 304 305 IF ( ln_ctl ) THEN 306 WRITE(numout,*) '****************' 307 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 308 WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc) 309 WRITE(numout,*) 'oasis_get: kstep', kstep 310 WRITE(numout,*) 'oasis_get: info ', kinfo 311 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 312 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 313 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 314 WRITE(numout,*) '****************' 350 llfisrt = .TRUE. 351 352 DO jm = 1, srcv(kid)%ncplmodel 353 354 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 355 356 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 357 358 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & 359 & kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 360 361 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 362 363 IF ( llaction ) THEN 364 365 kinfo = OASIS_Rcv 366 IF( llfisrt ) THEN 367 pdata(nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 368 llfisrt = .FALSE. 369 ELSE 370 pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 371 ENDIF 372 373 IF ( ln_ctl ) THEN 374 WRITE(numout,*) '****************' 375 WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 376 WRITE(numout,*) 'oasis_get: ivarid ' , srcv(kid)%nid(jc,jm) 377 WRITE(numout,*) 'oasis_get: kstep', kstep 378 WRITE(numout,*) 'oasis_get: info ', kinfo 379 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 380 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 381 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 382 WRITE(numout,*) '****************' 383 ENDIF 384 385 ENDIF 386 315 387 ENDIF 316 388 317 ELSE 318 kinfo = OASIS_idle 319 ENDIF 320 389 ENDDO 390 391 !--- Fill the overlap areas and extra hallows (mpp) 392 !--- check periodicity conditions (all cases) 393 IF( .not. llfisrt ) CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 394 321 395 ENDDO 322 396 ! -
branches/2014/dev_4728_CNRS04_coupled_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r4859 r4879 122 122 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 123 123 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 124 ! Other namelist parameters ! 125 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 126 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 127 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 128 129 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: xcplmask 124 130 125 131 TYPE :: DYNARR … … 147 153 !! *** FUNCTION sbc_cpl_alloc *** 148 154 !!---------------------------------------------------------------------- 149 INTEGER :: ierr( 2),jn155 INTEGER :: ierr(3) 150 156 !!---------------------------------------------------------------------- 151 157 ierr(:) = 0 … … 156 162 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) 157 163 #endif 164 ALLOCATE( xcplmask(jpi,jpj,nn_cplmodel) , STAT=ierr(3) ) 158 165 ! 159 166 sbc_cpl_alloc = MAXVAL( ierr ) … … 180 187 INTEGER :: jn ! dummy loop index 181 188 INTEGER :: ios ! Local integer output status for namelist read 189 INTEGER :: inum 182 190 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 183 191 !! 184 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 185 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 186 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx , sn_rcv_co2 192 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 193 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 194 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & 195 & sn_rcv_co2 , nn_cplmodel , ln_usecplmask 187 196 !!--------------------------------------------------------------------- 188 197 ! … … 232 241 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 233 242 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 243 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 244 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 234 245 ENDIF 235 246 … … 562 573 ! ================================ ! 563 574 564 CALL cpl_define(jprcv, jpsnd) 575 CALL cpl_define(jprcv, jpsnd,nn_cplmodel) 576 IF (ln_usecplmask) THEN 577 xcplmask(:,:,:) = 0. 578 CALL iom_open( 'cplmask', inum ) 579 CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel), & 580 & kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) ) 581 CALL iom_close( inum ) 582 ELSE 583 xcplmask(:,:,:) = 1. 584 ENDIF 565 585 ! 566 586 IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) ) & … … 639 659 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 640 660 DO jn = 1, jprcv ! received fields sent by the atmosphere 641 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) )661 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) ) 642 662 END DO 643 663
Note: See TracChangeset
for help on using the changeset viewer.