Changeset 4901 for branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC
- Timestamp:
- 2014-11-27T16:41:22+01:00 (10 years ago)
- Location:
- branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 2 deleted
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r3294 r4901 2 2 !!====================================================================== 3 3 !! *** MODULE cpl_oasis *** 4 !! Coupled O/A : coupled ocean-atmosphere case using OASIS3 V. prism_2_4 5 !! special case: NEMO OPA/LIM coupled to ECHAM5 4 !! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT 6 5 !!===================================================================== 7 6 !! History : … … 15 14 !! 3.4 ! 11-11 (C. Harris) Changes to allow mutiple category fields 16 15 !!---------------------------------------------------------------------- 16 !!---------------------------------------------------------------------- 17 !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3 18 !!---------------------------------------------------------------------- 19 !! cpl_init : initialization of coupled mode communication 20 !! cpl_define : definition of grid and fields 21 !! cpl_snd : snd out fields in coupled mode 22 !! cpl_rcv : receive fields in coupled mode 23 !! cpl_finalize : finalize the coupled mode communication 24 !!---------------------------------------------------------------------- 17 25 #if defined key_oasis3 18 !!---------------------------------------------------------------------- 19 !! 'key_oasis3' coupled Ocean/Atmosphere via OASIS3 20 !!---------------------------------------------------------------------- 21 !! cpl_prism_init : initialization of coupled mode communication 22 !! cpl_prism_define : definition of grid and fields 23 !! cpl_prism_snd : snd out fields in coupled mode 24 !! cpl_prism_rcv : receive fields in coupled mode 25 !! cpl_prism_finalize : finalize the coupled mode communication 26 !!---------------------------------------------------------------------- 27 USE mod_prism_proto ! OASIS3 prism module 28 USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning 29 USE mod_prism_put_proto ! OASIS3 prism module for snding 30 USE mod_prism_get_proto ! OASIS3 prism module for receiving 31 USE mod_comprism_proto ! OASIS3 prism module to get coupling frequency 26 USE mod_oasis ! OASIS3-MCT module 27 #endif 32 28 USE par_oce ! ocean parameters 33 29 USE dom_oce ! ocean space and time domain … … 38 34 PRIVATE 39 35 40 PUBLIC cpl_prism_init 41 PUBLIC cpl_prism_define 42 PUBLIC cpl_prism_snd 43 PUBLIC cpl_prism_rcv 44 PUBLIC cpl_prism_freq 45 PUBLIC cpl_prism_finalize 46 47 LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE. !: coupled flag 36 PUBLIC cpl_init 37 PUBLIC cpl_define 38 PUBLIC cpl_snd 39 PUBLIC cpl_rcv 40 PUBLIC cpl_freq 41 PUBLIC cpl_finalize 42 48 43 INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field 49 44 INTEGER, PUBLIC :: OASIS_idle = 0 !: return code if nothing done by oasis 50 INTEGER :: ncomp_id ! id returned by prism_init_comp45 INTEGER :: ncomp_id ! id returned by oasis_init_comp 51 46 INTEGER :: nerror ! return error code 52 53 INTEGER, PARAMETER :: nmaxfld=40 ! Maximum number of coupling fields 47 #if ! defined key_oasis3 48 ! OASIS Variables not used. defined only for compilation purpose 49 INTEGER :: OASIS_Out = -1 50 INTEGER :: OASIS_REAL = -1 51 INTEGER :: OASIS_Ok = -1 52 INTEGER :: OASIS_In = -1 53 INTEGER :: OASIS_Sent = -1 54 INTEGER :: OASIS_SentOut = -1 55 INTEGER :: OASIS_ToRest = -1 56 INTEGER :: OASIS_ToRestOut = -1 57 INTEGER :: OASIS_Recvd = -1 58 INTEGER :: OASIS_RecvOut = -1 59 INTEGER :: OASIS_FromRest = -1 60 INTEGER :: OASIS_FromRestOut = -1 61 #endif 62 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 54 66 55 67 TYPE, PUBLIC :: FLD_CPL !: Type for coupling field information … … 58 70 CHARACTER(len = 1) :: clgrid ! Grid type 59 71 REAL(wp) :: nsgn ! Control of the sign change 60 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) 61 73 INTEGER :: nct ! Number of categories in field 74 INTEGER :: ncplmodel ! Maximum number of models to/from which this variable may be sent/received 62 75 END TYPE FLD_CPL 63 76 … … 73 86 CONTAINS 74 87 75 SUBROUTINE cpl_ prism_init( kl_comm )88 SUBROUTINE cpl_init( kl_comm ) 76 89 !!------------------------------------------------------------------- 77 !! *** ROUTINE cpl_ prism_init ***90 !! *** ROUTINE cpl_init *** 78 91 !! 79 92 !! ** Purpose : Initialize coupled mode communication for ocean … … 89 102 90 103 !------------------------------------------------------------------ 91 ! 1st Initialize the PRISMsystem for the application104 ! 1st Initialize the OASIS system for the application 92 105 !------------------------------------------------------------------ 93 CALL prism_init_comp_proto( ncomp_id, 'oceanx', nerror )94 IF ( nerror /= PRISM_Ok ) &95 CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto')106 CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror ) 107 IF ( nerror /= OASIS_Ok ) & 108 CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') 96 109 97 110 !------------------------------------------------------------------ … … 99 112 !------------------------------------------------------------------ 100 113 101 CALL prism_get_localcomm_proto( kl_comm, nerror )102 IF ( nerror /= PRISM_Ok ) &103 CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' )104 ! 105 END SUBROUTINE cpl_ prism_init106 107 108 SUBROUTINE cpl_ prism_define( krcv, ksnd)114 CALL oasis_get_localcomm ( kl_comm, nerror ) 115 IF ( nerror /= OASIS_Ok ) & 116 CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 117 ! 118 END SUBROUTINE cpl_init 119 120 121 SUBROUTINE cpl_define( krcv, ksnd, kcplmodel ) 109 122 !!------------------------------------------------------------------- 110 !! *** ROUTINE cpl_ prism_define ***123 !! *** ROUTINE cpl_define *** 111 124 !! 112 125 !! ** Purpose : Define grid and field information for ocean … … 116 129 !!-------------------------------------------------------------------- 117 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 118 132 ! 119 133 INTEGER :: id_part 120 134 INTEGER :: paral(5) ! OASIS3 box partition 121 135 INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe 122 INTEGER :: ji,jc ! local loop indicees 123 CHARACTER(LEN=8) :: zclname 136 INTEGER :: ji,jc,jm ! local loop indicees 137 CHARACTER(LEN=64) :: zclname 138 CHARACTER(LEN=2) :: cli2 124 139 !!-------------------------------------------------------------------- 125 140 126 141 IF(lwp) WRITE(numout,*) 127 IF(lwp) WRITE(numout,*) 'cpl_ prism_define : initialization in coupled ocean/atmosphere case'142 IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case' 128 143 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 129 144 IF(lwp) WRITE(numout,*) 130 145 146 IF( kcplmodel > nmaxcpl ) THEN 147 CALL oasis_abort ( ncomp_id, 'cpl_define', 'kcplmodel is larger than nmaxcpl, increase nmaxcpl') ; RETURN 148 ENDIF 131 149 ! 132 150 ! ... Define the shape for the area that excludes the halo … … 141 159 ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror) 142 160 IF( nerror > 0 ) THEN 143 CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld') ; RETURN161 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN 144 162 ENDIF 145 163 ! … … 161 179 ENDIF 162 180 163 CALL prism_def_partition_proto( id_part, paral, nerror )181 CALL oasis_def_partition ( id_part, paral, nerror ) 164 182 ! 165 183 ! ... Announce send variables. 166 184 ! 185 ssnd(:)%ncplmodel = kcplmodel 186 ! 167 187 DO ji = 1, ksnd 168 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 169 196 DO jc = 1, ssnd(ji)%nct 170 IF ( ssnd(ji)%nct .gt. 1 ) THEN 171 WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc 172 ELSE 173 zclname=ssnd(ji)%clname 174 ENDIF 175 WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_Out 176 CALL prism_def_var_proto (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 177 PRISM_Out, ishape, PRISM_REAL, nerror) 178 IF ( nerror /= PRISM_Ok ) THEN 179 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 180 CALL prism_abort_proto ( ssnd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 181 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 182 224 END DO 183 225 ENDIF … … 188 230 DO ji = 1, krcv 189 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 190 239 DO jc = 1, srcv(ji)%nct 191 IF ( srcv(ji)%nct .gt. 1 ) THEN 192 WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc 193 ELSE 194 zclname=srcv(ji)%clname 195 ENDIF 196 WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In 197 CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/), & 198 & PRISM_In , ishape , PRISM_REAL, nerror) 199 IF ( nerror /= PRISM_Ok ) THEN 200 WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname) 201 CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var') 202 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 203 268 END DO 204 269 ENDIF … … 209 274 !------------------------------------------------------------------ 210 275 211 CALL prism_enddef_proto(nerror)212 IF( nerror /= PRISM_Ok ) CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef')213 ! 214 END SUBROUTINE cpl_ prism_define276 CALL oasis_enddef(nerror) 277 IF( nerror /= OASIS_Ok ) CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 278 ! 279 END SUBROUTINE cpl_define 215 280 216 281 217 SUBROUTINE cpl_ prism_snd( kid, kstep, pdata, kinfo )282 SUBROUTINE cpl_snd( kid, kstep, pdata, kinfo ) 218 283 !!--------------------------------------------------------------------- 219 !! *** ROUTINE cpl_ prism_snd ***284 !! *** ROUTINE cpl_snd *** 220 285 !! 221 286 !! ** Purpose : - At each coupling time-step,this routine sends fields … … 227 292 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdata 228 293 !! 229 INTEGER :: jc 294 INTEGER :: jc,jm ! local loop index 230 295 !!-------------------------------------------------------------------- 231 296 ! … … 233 298 ! 234 299 DO jc = 1, ssnd(kid)%nct 235 236 CALL prism_put_proto ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 237 238 IF ( ln_ctl ) THEN 239 IF ( kinfo == PRISM_Sent .OR. kinfo == PRISM_ToRest .OR. & 240 & kinfo == PRISM_SentOut .OR. kinfo == PRISM_ToRestOut ) THEN 241 WRITE(numout,*) '****************' 242 WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname 243 WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid(jc) 244 WRITE(numout,*) 'prism_put_proto: kstep ', kstep 245 WRITE(numout,*) 'prism_put_proto: info ', kinfo 246 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 247 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 248 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 249 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 250 320 ENDIF 251 ENDIF252 321 322 ENDDO 253 323 ENDDO 254 324 ! 255 END SUBROUTINE cpl_ prism_snd256 257 258 SUBROUTINE cpl_ prism_rcv( kid, kstep, pdata, kinfo )325 END SUBROUTINE cpl_snd 326 327 328 SUBROUTINE cpl_rcv( kid, kstep, pdata, pmask, kinfo ) 259 329 !!--------------------------------------------------------------------- 260 !! *** ROUTINE cpl_ prism_rcv ***330 !! *** ROUTINE cpl_rcv *** 261 331 !! 262 332 !! ** Purpose : - At each coupling time-step,this routine receives fields … … 266 336 INTEGER , INTENT(in ) :: kstep ! ocean time-step in seconds 267 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 268 339 INTEGER , INTENT( out) :: kinfo ! OASIS3 info argument 269 340 !! 270 INTEGER :: jc 271 LOGICAL :: llaction 341 INTEGER :: jc,jm ! local loop index 342 LOGICAL :: llaction, llfisrt 272 343 !!-------------------------------------------------------------------- 273 344 ! 274 345 ! receive local data from OASIS3 on every process 275 346 ! 347 kinfo = OASIS_idle 348 ! 276 349 DO jc = 1, srcv(kid)%nct 277 278 CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo ) 279 280 llaction = .false. 281 IF( kinfo == PRISM_Recvd .OR. kinfo == PRISM_FromRest .OR. & 282 kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut ) llaction = .TRUE. 283 284 IF ( ln_ctl ) WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc) 285 286 IF ( llaction ) THEN 287 288 kinfo = OASIS_Rcv 289 pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:) 290 291 !--- Fill the overlap areas and extra hallows (mpp) 292 !--- check periodicity conditions (all cases) 293 CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn ) 294 295 IF ( ln_ctl ) THEN 296 WRITE(numout,*) '****************' 297 WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname 298 WRITE(numout,*) 'prism_get_proto: ivarid ' , srcv(kid)%nid(jc) 299 WRITE(numout,*) 'prism_get_proto: kstep', kstep 300 WRITE(numout,*) 'prism_get_proto: info ', kinfo 301 WRITE(numout,*) ' - Minimum value is ', MINVAL(pdata(:,:,jc)) 302 WRITE(numout,*) ' - Maximum value is ', MAXVAL(pdata(:,:,jc)) 303 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 304 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 305 387 ENDIF 306 388 307 ELSE 308 kinfo = OASIS_idle 309 ENDIF 310 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 311 395 ENDDO 312 396 ! 313 END SUBROUTINE cpl_ prism_rcv314 315 316 INTEGER FUNCTION cpl_ prism_freq( kid )397 END SUBROUTINE cpl_rcv 398 399 400 INTEGER FUNCTION cpl_freq( kid ) 317 401 !!--------------------------------------------------------------------- 318 !! *** ROUTINE cpl_ prism_freq ***402 !! *** ROUTINE cpl_freq *** 319 403 !! 320 404 !! ** Purpose : - send back the coupling frequency for a particular field 321 405 !!---------------------------------------------------------------------- 322 INTEGER,INTENT(in) :: kid ! variable index 406 INTEGER,INTENT(in) :: kid ! variable index 407 !! 408 INTEGER :: info 323 409 !!---------------------------------------------------------------------- 324 cpl_prism_freq = ig_def_freq( kid)325 ! 326 END FUNCTION cpl_ prism_freq327 328 329 SUBROUTINE cpl_ prism_finalize410 CALL oasis_get_freqs(kid, 1, cpl_freq, info) 411 ! 412 END FUNCTION cpl_freq 413 414 415 SUBROUTINE cpl_finalize 330 416 !!--------------------------------------------------------------------- 331 !! *** ROUTINE cpl_ prism_finalize ***417 !! *** ROUTINE cpl_finalize *** 332 418 !! 333 419 !! ** Purpose : - Finalizes the coupling. If MPI_init has not been 334 !! called explicitly before cpl_ prism_init it will also close420 !! called explicitly before cpl_init it will also close 335 421 !! MPI communication. 336 422 !!---------------------------------------------------------------------- 337 423 ! 338 424 DEALLOCATE( exfld ) 339 CALL prism_terminate_proto( nerror ) 340 ! 341 END SUBROUTINE cpl_prism_finalize 342 343 #else 344 !!---------------------------------------------------------------------- 345 !! Default case Dummy module Forced Ocean/Atmosphere 346 !!---------------------------------------------------------------------- 347 USE in_out_manager ! I/O manager 348 LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE. !: coupled flag 349 PUBLIC cpl_prism_init 350 PUBLIC cpl_prism_finalize 351 CONTAINS 352 SUBROUTINE cpl_prism_init (kl_comm) 353 INTEGER, INTENT(out) :: kl_comm ! local communicator of the model 354 kl_comm = -1 355 WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...' 356 END SUBROUTINE cpl_prism_init 357 SUBROUTINE cpl_prism_finalize 358 WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...' 359 END SUBROUTINE cpl_prism_finalize 425 IF (nstop == 0) THEN 426 CALL oasis_terminate( nerror ) 427 ELSE 428 CALL oasis_abort( ncomp_id, "cpl_finalize", "NEMO ABORT STOP" ) 429 ENDIF 430 ! 431 END SUBROUTINE cpl_finalize 432 433 #if ! defined key_oasis3 434 435 !!---------------------------------------------------------------------- 436 !! No OASIS Library OASIS3 Dummy module... 437 !!---------------------------------------------------------------------- 438 439 SUBROUTINE oasis_init_comp(k1,cd1,k2) 440 CHARACTER(*), INTENT(in ) :: cd1 441 INTEGER , INTENT( out) :: k1,k2 442 k1 = -1 ; k2 = -1 443 WRITE(numout,*) 'oasis_init_comp: Error you sould not be there...', cd1 444 END SUBROUTINE oasis_init_comp 445 446 SUBROUTINE oasis_abort(k1,cd1,cd2) 447 INTEGER , INTENT(in ) :: k1 448 CHARACTER(*), INTENT(in ) :: cd1,cd2 449 WRITE(numout,*) 'oasis_abort: Error you sould not be there...', cd1, cd2 450 END SUBROUTINE oasis_abort 451 452 SUBROUTINE oasis_get_localcomm(k1,k2) 453 INTEGER , INTENT( out) :: k1,k2 454 k1 = -1 ; k2 = -1 455 WRITE(numout,*) 'oasis_get_localcomm: Error you sould not be there...' 456 END SUBROUTINE oasis_get_localcomm 457 458 SUBROUTINE oasis_def_partition(k1,k2,k3) 459 INTEGER , INTENT( out) :: k1,k3 460 INTEGER , INTENT(in ) :: k2(5) 461 k1 = k2(1) ; k3 = k2(5) 462 WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...' 463 END SUBROUTINE oasis_def_partition 464 465 SUBROUTINE oasis_def_var(k1,cd1,k2,k3,k4,k5,k6,k7) 466 CHARACTER(*), INTENT(in ) :: cd1 467 INTEGER , INTENT(in ) :: k2,k3(2),k4,k5(2,2),k6 468 INTEGER , INTENT( out) :: k1,k7 469 k1 = -1 ; k7 = -1 470 WRITE(numout,*) 'oasis_def_var: Error you sould not be there...', cd1 471 END SUBROUTINE oasis_def_var 472 473 SUBROUTINE oasis_enddef(k1) 474 INTEGER , INTENT( out) :: k1 475 k1 = -1 476 WRITE(numout,*) 'oasis_enddef: Error you sould not be there...' 477 END SUBROUTINE oasis_enddef 478 479 SUBROUTINE oasis_put(k1,k2,p1,k3) 480 REAL(wp), DIMENSION(:,:), INTENT(in ) :: p1 481 INTEGER , INTENT(in ) :: k1,k2 482 INTEGER , INTENT( out) :: k3 483 k3 = -1 484 WRITE(numout,*) 'oasis_put: Error you sould not be there...' 485 END SUBROUTINE oasis_put 486 487 SUBROUTINE oasis_get(k1,k2,p1,k3) 488 REAL(wp), DIMENSION(:,:), INTENT( out) :: p1 489 INTEGER , INTENT(in ) :: k1,k2 490 INTEGER , INTENT( out) :: k3 491 p1(1,1) = -1. ; k3 = -1 492 WRITE(numout,*) 'oasis_get: Error you sould not be there...' 493 END SUBROUTINE oasis_get 494 495 SUBROUTINE oasis_get_freqs(k1,k2,k3,k4) 496 INTEGER , INTENT(in ) :: k1,k2 497 INTEGER , INTENT( out) :: k3,k4 498 k3 = k1 ; k4 = k2 499 WRITE(numout,*) 'oasis_get_freqs: Error you sould not be there...' 500 END SUBROUTINE oasis_get_freqs 501 502 SUBROUTINE oasis_terminate(k1) 503 INTEGER , INTENT( out) :: k1 504 k1 = -1 505 WRITE(numout,*) 'oasis_terminate: Error you sould not be there...' 506 END SUBROUTINE oasis_terminate 507 360 508 #endif 361 509 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r4306 r4901 14 14 !!---------------------------------------------------------------------- 15 15 USE par_oce ! ocean parameters 16 USE sbc_oce ! surface boundary condition: ocean 16 17 # if defined key_lim3 17 18 USE par_ice ! LIM-3 parameters … … 56 57 57 58 #if defined key_lim3 || defined key_lim2 58 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qns_ice !: non solar heat flux over ice [W/m2] 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice !: solar heat flux over ice [W/m2] 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice_mean !: dauly mean solar heat flux over ice [W/m2] 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qla_ice !: latent flux over ice [W/m2] 62 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqla_ice !: latent sensibility over ice [W/m2/K] 63 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqns_ice !: non solar heat flux over ice (LW+SEN+LA) [W/m2/K] 64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice !: ice surface temperature [K] 65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: alb_ice !: albedo of ice 66 67 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_ice !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts [N/m2] 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtau_ice !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts [N/m2] 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr1_i0 !: 1st Qsr fraction penetrating inside ice cover [-] 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr2_i0 !: 2nd Qsr fraction penetrating inside ice cover [-] 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation-snow budget over ice [kg/m2] 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qns_ice !: non solar heat flux over ice [W/m2] 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice !: solar heat flux over ice [W/m2] 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice_mean !: daily mean solar heat flux over ice [W/m2] 62 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qla_ice !: latent flux over ice [W/m2] 63 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqla_ice !: latent sensibility over ice [W/m2/K] 64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dqns_ice !: non solar heat flux over ice (LW+SEN+LA) [W/m2/K] 65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice !: ice surface temperature [K] 66 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: alb_ice !: ice albedo [-] 67 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_ice !: atmos-ice u-stress. VP: I-pt ; EVP: U,V-pts [N/m2] 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vtau_ice !: atmos-ice v-stress. VP: I-pt ; EVP: U,V-pts [N/m2] 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr1_i0 !: Solar surface transmission parameter, thick ice [-] 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr2_i0 !: Solar surface transmission parameter, thin ice [-] 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation - precip over sea ice [kg/m2] 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qemp_ice !: heat associated with emp over sea ice [W/m2] 72 74 73 75 # if defined key_lim3 74 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tatm_ice !: air temperature76 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tatm_ice !: air temperature [K] 75 77 # endif 76 78 … … 98 100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt !: category topmelt 99 101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: botmelt !: category botmelt 100 #endif 102 103 ! variables used in the coupled interface 104 INTEGER , PUBLIC, PARAMETER :: jpl = ncat 105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice, alb_ice, qns_ice, dqns_ice ! (jpi,jpj,jpl) 107 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice 108 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice 109 #endif 110 111 #if defined key_lim2 112 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i 113 #endif 114 115 #if ! defined key_lim3 116 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i, ht_s 117 #endif 118 119 #if ! defined key_cice 120 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt, botmelt 121 #endif 122 123 REAL(wp), PUBLIC, SAVE :: cldf_ice = 0.81 !: cloud fraction over sea ice, summer CLIO value [-] 101 124 102 125 !!---------------------------------------------------------------------- … … 111 134 !! *** FUNCTION sbc_ice_alloc *** 112 135 !!---------------------------------------------------------------------- 113 INTEGER :: ierr( 2)136 INTEGER :: ierr(5) 114 137 !!---------------------------------------------------------------------- 115 138 ierr(:) = 0 … … 123 146 & fr1_i0 (jpi,jpj) , fr2_i0 (jpi,jpj) , & 124 147 #if defined key_lim3 125 & emp_ice(jpi,jpj) , tatm_ice(jpi,jpj) , STAT= ierr(1) ) 126 #else 127 & emp_ice(jpi,jpj) , STAT= ierr(1) ) 128 #endif 148 & tatm_ice(jpi,jpj) , & 149 #endif 150 & emp_ice(jpi,jpj) , qemp_ice(jpi,jpj) , STAT= ierr(1) ) 129 151 #elif defined key_cice 130 152 ALLOCATE( qla_ice(jpi,jpj,1) , qlw_ice(jpi,jpj,1) , qsr_ice(jpi,jpj,1) , & … … 132 154 wndj_ice(jpi,jpj) , nfrzmlt(jpi,jpj) , ss_iou(jpi,jpj) , & 133 155 ss_iov(jpi,jpj) , fr_iu(jpi,jpj) , fr_iv(jpi,jpj) , & 134 a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat), STAT= ierr(1) ) 156 a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 157 STAT= ierr(1) ) 158 IF( lk_cpl ) ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , & 159 & v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1) , & 160 & emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , & 161 & STAT= ierr(2) ) 162 135 163 #endif 136 164 ! 137 165 #if defined key_lim2 138 IF( ltrcdm2dc_ice )THEN 139 ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(2) ) 140 ENDIF 166 IF( ltrcdm2dc_ice ) ALLOCATE( qsr_ice_mean (jpi,jpj,jpl), STAT=ierr(3) ) 141 167 #endif 142 168 ! 169 #if defined key_lim2 170 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(4) ) 171 #endif 172 173 #if defined key_cice || defined key_lim2 174 IF( lk_cpl ) ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 175 #endif 176 143 177 sbc_ice_alloc = MAXVAL( ierr ) 144 178 IF( lk_mpp ) CALL mpp_sum ( sbc_ice_alloc ) … … 150 184 !! Default option NO LIM 2.0 or 3.0 or CICE sea-ice model 151 185 !!---------------------------------------------------------------------- 186 USE in_out_manager ! I/O manager 152 187 LOGICAL , PUBLIC, PARAMETER :: lk_lim2 = .FALSE. !: no LIM-2 ice model 153 188 LOGICAL , PUBLIC, PARAMETER :: lk_lim3 = .FALSE. !: no LIM-3 ice model 154 189 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .FALSE. !: no CICE ice model 155 190 CHARACTER(len=1), PUBLIC, PARAMETER :: cp_ice_msh = '-' !: no grid ice-velocity 191 REAL , PUBLIC, PARAMETER :: cldf_ice = 0.81 !: cloud fraction over sea ice, summer CLIO value [-] 192 INTEGER , PUBLIC, PARAMETER :: jpl = 1 193 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj 194 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice, alb_ice, qns_ice, dqns_ice ! (jpi,jpj,jpl) 195 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i 196 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice 197 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice 198 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i, ht_s 199 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt, botmelt 156 200 #endif 157 201 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r4306 r4901 35 35 LOGICAL , PUBLIC :: ln_blk_core !: CORE bulk formulation 36 36 LOGICAL , PUBLIC :: ln_blk_mfs !: MFS bulk formulation 37 LOGICAL , PUBLIC :: ln_cpl !: coupled formulation (overwritten by key_sbc_coupled ) 37 #if defined key_oasis3 38 LOGICAL , PUBLIC :: lk_cpl = .TRUE. !: coupled formulation 39 #else 40 LOGICAL , PUBLIC :: lk_cpl = .FALSE. !: coupled formulation 41 #endif 38 42 LOGICAL , PUBLIC :: ln_dm2dc !: Daily mean to Diurnal Cycle short wave (qsr) 39 43 LOGICAL , PUBLIC :: ln_rnf !: runoffs / runoff mouths … … 45 49 ! !: =1 levitating ice with mass and salt exchange but no presure effect 46 50 ! !: =2 embedded sea-ice (full salt and mass exchanges and pressure) 51 INTEGER , PUBLIC :: nn_limflx !: LIM3 Multi-category heat flux formulation 52 ! !: =-1 Use of per-category fluxes 53 ! !: = 0 Average per-category fluxes 54 ! !: = 1 Average then redistribute per-category fluxes 55 ! !: = 2 Redistribute a single flux over categories 47 56 INTEGER , PUBLIC :: nn_fwb !: FreshWater Budget: 48 57 ! !: = 0 unchecked … … 55 64 LOGICAL , PUBLIC :: ln_icebergs !: Icebergs 56 65 ! 57 CHARACTER (len=8), PUBLIC :: cn_iceflx !: Flux handling over ice categories 58 LOGICAL, PUBLIC :: ln_iceflx_ave ! Average heat fluxes over all ice categories 59 LOGICAL, PUBLIC :: ln_iceflx_linear ! Redistribute mean heat fluxes over all ice categories, using ice temperature and albedo 60 ! 61 INTEGER , PUBLIC :: nn_lsm !: Number of iteration if seaoverland is applied 66 INTEGER , PUBLIC :: nn_lsm !: Number of iteration if seaoverland is applied 67 !!---------------------------------------------------------------------- 68 !! switch definition (improve readability) 69 !!---------------------------------------------------------------------- 70 INTEGER , PUBLIC, PARAMETER :: jp_gyre = 0 !: GYRE analytical formulation 71 INTEGER , PUBLIC, PARAMETER :: jp_ana = 1 !: analytical formulation 72 INTEGER , PUBLIC, PARAMETER :: jp_flx = 2 !: flux formulation 73 INTEGER , PUBLIC, PARAMETER :: jp_clio = 3 !: CLIO bulk formulation 74 INTEGER , PUBLIC, PARAMETER :: jp_core = 4 !: CORE bulk formulation 75 INTEGER , PUBLIC, PARAMETER :: jp_cpl = 5 !: Coupled formulation 76 INTEGER , PUBLIC, PARAMETER :: jp_mfs = 6 !: MFS bulk formulation 77 INTEGER , PUBLIC, PARAMETER :: jp_esopa = -1 !: esopa test, ALL formulations 78 62 79 !!---------------------------------------------------------------------- 63 80 !! Ocean Surface Boundary Condition fields -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
r4897 r4901 114 114 !! - utau, vtau i- and j-component of the wind stress 115 115 !! - taum wind stress module at T-point 116 !! - wndm 10m wind module at T-point 116 !! - wndm 10m wind module at T-point over free ocean or leads in presence of sea-ice 117 117 !! - qns non-solar heat flux including latent heat of solid 118 118 !! precip. melting and emp heat content … … 204 204 !! - utau, vtau i- and j-component of the wind stress 205 205 !! - taum wind stress module at T-point 206 !! - wndm 10m wind module at T-point 206 !! - wndm 10m wind module at T-point over free ocean or leads in presence of sea-ice 207 207 !! - qns non-solar heat flux including latent heat of solid 208 208 !! precip. melting and emp heat content … … 398 398 399 399 400 SUBROUTINE blk_ice_clio( pst , palb_cs, palb_os ,&400 SUBROUTINE blk_ice_clio( pst , palb_cs, palb_os, palb, & 401 401 & p_taui, p_tauj, p_qns , p_qsr, & 402 402 & p_qla , p_dqns, p_dqla, & … … 427 427 !!---------------------------------------------------------------------- 428 428 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: pst ! ice surface temperature [Kelvin] 429 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [%] 430 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_os ! ice albedo (overcast sky) (alb_ice_os) [%] 429 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_cs ! ice albedo (clear sky) (alb_ice_cs) [-] 430 REAL(wp), INTENT(in ), DIMENSION(:,:,:) :: palb_os ! ice albedo (overcast sky) (alb_ice_os) [-] 431 REAL(wp), INTENT( out), DIMENSION(:,:,:) :: palb ! ice albedo (actual value) [-] 431 432 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_taui ! surface ice stress at I-point (i-component) [N/m2] 432 433 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tauj ! surface ice stress at I-point (j-component) [N/m2] … … 438 439 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_tpr ! total precipitation (T-point) [Kg/m2/s] 439 440 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_spr ! solid precipitation (T-point) [Kg/m2/s] 440 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr1 ! 1sr fraction of qsr penetration in ice [ %]441 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr2 ! 2nd fraction of qsr penetration in ice [ %]441 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr1 ! 1sr fraction of qsr penetration in ice [-] 442 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: p_fr2 ! 2nd fraction of qsr penetration in ice [-] 442 443 CHARACTER(len=1), INTENT(in ) :: cd_grid ! type of sea-ice grid ("C" or "B" grid) 443 444 INTEGER, INTENT(in ) :: pdim ! number of ice categories … … 542 543 !-----------------------------------------------------------! 543 544 CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr ) 545 546 DO jl = 1, ijpl 547 palb(:,:,jl) = ( palb_cs(:,:,jl) * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) & 548 & + palb_os(:,:,jl) * sf(jp_ccov)%fnow(ji,jj,1) ) 549 END DO 544 550 545 551 ! ! ========================== ! -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r4898 r4901 44 44 USE prtctl ! Print control 45 45 USE sbcwave, ONLY : cdn_wave ! wave module 46 #if defined key_lim3 || defined key_cice47 46 USE sbc_ice ! Surface boundary condition: ice fields 48 #endif49 47 USE lib_fortran ! to use key_nosignedzero 50 48 … … 121 119 !! ** Action : defined at each time-step at the air-sea interface 122 120 !! - utau, vtau i- and j-component of the wind stress 123 !! - taum, wndm wind stress and 10m wind modules at T-point 121 !! - taum wind stress module at T-point 122 !! - wndm wind speed module at T-point over free ocean or leads in presence of sea-ice 124 123 !! - qns, qsr non-solar and solar heat fluxes 125 124 !! - emp upward mass flux (evapo. - precip.) … … 232 231 !! - qsr : Solar heat flux over the ocean (W/m2) 233 232 !! - qns : Non Solar heat flux over the ocean (W/m2) 234 !! - evap : Evaporation over the ocean (kg/m2/s)235 233 !! - emp : evaporation minus precipitation (kg/m2/s) 236 234 !! … … 425 423 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pui ! ice surface velocity (i- and i- components [m/s] 426 424 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pvi ! at I-point (B-grid) or U & V-point (C-grid) 427 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb ! ice albedo ( clear sky) (alb_ice_cs)[%]425 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: palb ! ice albedo (all skies) [%] 428 426 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_taui ! i- & j-components of surface ice stress [N/m2] 429 427 REAL(wp), DIMENSION(:,:) , INTENT( out) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) … … 445 443 REAL(wp) :: zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb 446 444 REAL(wp) :: zztmp ! temporary variable 447 REAL(wp) :: zcoef_frca ! fractional cloud amount448 445 REAL(wp) :: zwnorm_f, zwndi_f , zwndj_f ! relative wind module and components at F-point 449 446 REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point … … 469 466 zcoef_dqla = -Ls * Cice * 11637800. * (-5897.8) 470 467 zcoef_dqsb = rhoa * cpa * Cice 471 zcoef_frca = 1.0 - 0.3472 468 473 469 !!gm brutal.... … … 587 583 ! ( Maykut and Untersteiner, 1971 ; Ebert and Curry, 1993 ) 588 584 589 p_fr1(:,:) = ( 0.18 * ( 1.0 - zcoef_frca ) + 0.35 * zcoef_frca)590 p_fr2(:,:) = ( 0.82 * ( 1.0 - zcoef_frca ) + 0.65 * zcoef_frca)585 p_fr1(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 586 p_fr2(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 591 587 592 588 p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac ! total precipitation [kg/m2/s] -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
r4897 r4901 82 82 !! - utau, vtau i- and j-component of the wind stress 83 83 !! - taum wind stress module at T-point 84 !! - wndm 10m wind module at T-point 84 !! - wndm 10m wind module at T-point over free ocean or leads in presence of sea-ice 85 85 !! - qns, qsr non-slor and solar heat flux 86 86 !! - emp evaporation minus precipitation -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r4897 r4901 9 9 !! 3.4 ! 2011_11 (C. Harris) more flexibility + multi-category fields 10 10 !!---------------------------------------------------------------------- 11 #if defined key_oasis3 || defined key_oasis412 !!----------------------------------------------------------------------13 !! 'key_oasis3' or 'key_oasis4' Coupled Ocean/Atmosphere formulation14 11 !!---------------------------------------------------------------------- 15 12 !! namsbc_cpl : coupled formulation namlist … … 34 31 USE ice_2 ! ice variables 35 32 #endif 36 #if defined key_oasis337 33 USE cpl_oasis3 ! OASIS3 coupling 38 #endif39 #if defined key_oasis440 USE cpl_oasis4 ! OASIS4 coupling41 #endif42 34 USE geo2ocean ! 43 35 USE oce , ONLY : tsn, un, vn … … 58 50 IMPLICIT NONE 59 51 PRIVATE 60 52 !EM XIOS-OASIS-MCT compliance 53 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 61 54 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F90 62 55 PUBLIC sbc_cpl_snd ! routine called by step.F90 … … 129 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 130 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 131 130 132 131 TYPE :: DYNARR … … 139 138 140 139 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument 141 142 #if ! defined key_lim2 && ! defined key_lim3143 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice,fr1_i0,fr2_i0 ! jpi, jpj144 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_ice, alb_ice, qns_ice, dqns_ice ! (jpi,jpj,jpl)145 #endif146 147 #if defined key_cice148 INTEGER, PARAMETER :: jpl = ncat149 #elif ! defined key_lim2 && ! defined key_lim3150 INTEGER, PARAMETER :: jpl = 1151 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice152 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice153 #endif154 155 #if ! defined key_lim3 && ! defined key_cice156 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i157 #endif158 159 #if ! defined key_lim3160 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i, ht_s161 #endif162 163 #if ! defined key_cice164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt, botmelt165 #endif166 140 167 141 !! Substitution … … 179 153 !! *** FUNCTION sbc_cpl_alloc *** 180 154 !!---------------------------------------------------------------------- 181 INTEGER :: ierr( 4),jn155 INTEGER :: ierr(3) 182 156 !!---------------------------------------------------------------------- 183 157 ierr(:) = 0 184 158 ! 185 159 ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) ) 186 ! 187 #if ! defined key_lim2 && ! defined key_lim3 188 ! quick patch to be able to run the coupled model without sea-ice... 189 ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , & 190 v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1), & 191 emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , STAT=ierr(2) ) 160 161 #if ! defined key_lim3 && ! defined key_lim2 && ! defined key_cice 162 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) 192 163 #endif 193 194 #if ! defined key_lim3 && ! defined key_cice 195 ALLOCATE( a_i(jpi,jpj,jpl) , STAT=ierr(3) ) 196 #endif 197 198 #if defined key_cice || defined key_lim2 199 ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(4) ) 200 #endif 164 ALLOCATE( xcplmask(jpi,jpj,nn_cplmodel) , STAT=ierr(3) ) 165 ! 201 166 sbc_cpl_alloc = MAXVAL( ierr ) 202 167 IF( lk_mpp ) CALL mpp_sum ( sbc_cpl_alloc ) … … 210 175 !! *** ROUTINE sbc_cpl_init *** 211 176 !! 212 !! ** Purpose : Initialisation of send and rec ieved information from177 !! ** Purpose : Initialisation of send and received information from 213 178 !! the atmospheric component 214 179 !! … … 222 187 INTEGER :: jn ! dummy loop index 223 188 INTEGER :: ios ! Local integer output status for namelist read 189 INTEGER :: inum 224 190 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 225 191 !! 226 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 227 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 228 & 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 229 196 !!--------------------------------------------------------------------- 230 197 ! … … 274 241 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 275 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 276 245 ENDIF 277 246 … … 604 573 ! ================================ ! 605 574 606 CALL cpl_prism_define(jprcv, jpsnd) 607 ! 608 IF( ln_dm2dc .AND. ( cpl_prism_freq( jpr_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) ) & 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 585 ! 586 IF( ln_dm2dc .AND. ( cpl_freq( jpr_qsroce ) + cpl_freq( jpr_qsrmix ) /= 86400 ) ) & 609 587 & CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 610 588 … … 654 632 !! 655 633 !! ** Action : update utau, vtau ocean stress at U,V grid 656 !! taum, wndm wind stres and wind speed module at T-point 634 !! taum wind stress module at T-point 635 !! wndm wind speed module at T-point over free ocean or leads in presence of sea-ice 657 636 !! qns non solar heat fluxes including emp heat content (ocean only case) 658 637 !! and the latent heat flux of solid precip. melting … … 678 657 ! 679 658 CALL wrk_alloc( jpi,jpj, ztx, zty ) 680 681 IF( kt == nit000 ) CALL sbc_cpl_init( k_ice ) ! initialisation682 683 659 ! ! Receive all the atmos. fields (including ice information) 684 660 isec = ( kt - nit000 ) * NINT( rdttra(1) ) ! date of exchanges 685 661 DO jn = 1, jprcv ! received fields sent by the atmosphere 686 IF( srcv(jn)%laction ) CALL cpl_ prism_rcv( jn, isec, frcv(jn)%z3, nrcvinfo(jn) )662 IF( srcv(jn)%laction ) CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask, nrcvinfo(jn) ) 687 663 END DO 688 664 … … 848 824 IF( srcv(jpr_qnsoce)%laction ) qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 849 825 IF( srcv(jpr_qnsmix)%laction ) qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 850 ! add the latent heat of solid precip. melting851 IF( srcv(jpr_snow )%laction ) THEN ! update qns over the free ocean with:852 qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus & ! energy for melting solid precipitation over the free ocean853 & - emp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST)826 ! update qns over the free ocean with: 827 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 828 IF( srcv(jpr_snow )%laction ) THEN 829 qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus ! energy for melting solid precipitation over the free ocean 854 830 ENDIF 855 831 … … 914 890 CALL wrk_alloc( jpi,jpj, ztx, zty ) 915 891 916 !AC Pour eviter un stress nul sur la glace dans le cas mixed oce-ice 917 IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN ; itx = jpr_itx1 892 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 918 893 ELSE ; itx = jpr_otx1 919 894 ENDIF … … 922 897 IF( nrcvinfo(itx) == OASIS_Rcv ) THEN 923 898 924 ! ! ======================= ! 925 !AC Pour eviter un stress nul sur la glace dans le cas mixes oce-ice 926 IF( srcv(jpr_itx1)%laction .AND. TRIM( sn_rcv_tau%cldes ) == 'oce and ice') THEN ! ice stress received ! 927 ! ! ======================= ! 899 ! ! ======================= ! 900 IF( srcv(jpr_itx1)%laction ) THEN ! ice stress received ! 901 ! ! ======================= ! 928 902 ! 929 903 IF( TRIM( sn_rcv_tau%clvref ) == 'cartesian' ) THEN ! 2 components on the sphere … … 1125 1099 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] 1126 1100 ! optional arguments, used only in 'mixed oce-ice' case 1127 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! ice albedo1128 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Cel cius]1101 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1102 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1129 1103 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1130 1104 ! … … 1296 1270 ENDIF 1297 1271 1298 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) 1272 ! ! ========================= ! 1273 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt ! 1274 ! ! ========================= ! 1299 1275 CASE ('coupled') 1300 1276 IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN … … 1308 1284 END SELECT 1309 1285 1310 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) 1286 ! ! ========================= ! 1287 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt ! 1288 ! ! ========================= ! 1311 1289 CASE ('coupled') 1312 1290 topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) … … 1314 1292 END SELECT 1315 1293 1316 ! Ice Qsr penetration used (only?)in lim2 or lim3 1317 ! fraction of net shortwave radiation which is not absorbed in the thin surface layer 1318 ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 1294 ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 1295 ! Used for LIM2 and LIM3 1319 1296 ! Coupled case: since cloud cover is not received from atmosphere 1320 ! ===> defined as constant value -> definition done in sbc_cpl_init 1321 fr1_i0(:,:) = 0.18 1322 fr2_i0(:,:) = 0.82 1323 1297 ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 1298 fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 1299 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1324 1300 1325 1301 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) … … 1336 1312 !! ** Purpose : provide the ocean-ice informations to the atmosphere 1337 1313 !! 1338 !! ** Method : send to the atmosphere through a call to cpl_ prism_snd1314 !! ** Method : send to the atmosphere through a call to cpl_snd 1339 1315 !! all the needed fields (as defined in sbc_cpl_init) 1340 1316 !!---------------------------------------------------------------------- … … 1355 1331 1356 1332 zfr_l(:,:) = 1.- fr_i(:,:) 1357 1358 1333 ! ! ------------------------- ! 1359 1334 ! ! Surface temperature ! in Kelvin … … 1380 1355 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1381 1356 END SELECT 1382 IF( ssnd(jps_toce)%laction ) CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1383 IF( ssnd(jps_tice)%laction ) CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 1384 IF( ssnd(jps_tmix)%laction ) CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1385 ENDIF 1386 ! 1357 IF( ssnd(jps_toce)%laction ) CALL cpl_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1358 IF( ssnd(jps_tice)%laction ) CALL cpl_snd( jps_tice, isec, ztmp3, info ) 1359 IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1360 ENDIF 1387 1361 ! ! ------------------------- ! 1388 1362 ! ! Albedo ! … … 1390 1364 IF( ssnd(jps_albice)%laction ) THEN ! ice 1391 1365 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1392 CALL cpl_ prism_snd( jps_albice, isec, ztmp3, info )1366 CALL cpl_snd( jps_albice, isec, ztmp3, info ) 1393 1367 ENDIF 1394 1368 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean … … 1397 1371 ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 1398 1372 ENDDO 1399 CALL cpl_ prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )1373 CALL cpl_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1400 1374 ENDIF 1401 1375 ! ! ------------------------- ! … … 1409 1383 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1410 1384 END SELECT 1411 CALL cpl_ prism_snd( jps_fice, isec, ztmp3, info )1385 CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1412 1386 ENDIF 1413 1387 … … 1434 1408 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 1435 1409 END SELECT 1436 IF( ssnd(jps_hice)%laction ) CALL cpl_ prism_snd( jps_hice, isec, ztmp3, info )1437 IF( ssnd(jps_hsnw)%laction ) CALL cpl_ prism_snd( jps_hsnw, isec, ztmp4, info )1410 IF( ssnd(jps_hice)%laction ) CALL cpl_snd( jps_hice, isec, ztmp3, info ) 1411 IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 1438 1412 ENDIF 1439 1413 ! … … 1442 1416 ! ! CO2 flux from PISCES ! 1443 1417 ! ! ------------------------- ! 1444 IF( ssnd(jps_co2)%laction ) CALL cpl_ prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )1418 IF( ssnd(jps_co2)%laction ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 1445 1419 ! 1446 1420 #endif … … 1565 1539 ENDIF 1566 1540 ! 1567 IF( ssnd(jps_ocx1)%laction ) CALL cpl_ prism_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid1568 IF( ssnd(jps_ocy1)%laction ) CALL cpl_ prism_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid1569 IF( ssnd(jps_ocz1)%laction ) CALL cpl_ prism_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid1541 IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid 1542 IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid 1543 IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid 1570 1544 ! 1571 IF( ssnd(jps_ivx1)%laction ) CALL cpl_ prism_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid1572 IF( ssnd(jps_ivy1)%laction ) CALL cpl_ prism_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid1573 IF( ssnd(jps_ivz1)%laction ) CALL cpl_ prism_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid1545 IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid 1546 IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid 1547 IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid 1574 1548 ! 1575 1549 ENDIF … … 1582 1556 END SUBROUTINE sbc_cpl_snd 1583 1557 1584 #else1585 !!----------------------------------------------------------------------1586 !! Dummy module NO coupling1587 !!----------------------------------------------------------------------1588 USE par_kind ! kind definition1589 CONTAINS1590 SUBROUTINE sbc_cpl_snd( kt )1591 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt1592 END SUBROUTINE sbc_cpl_snd1593 !1594 SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )1595 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt, k_fsbc, k_ice1596 END SUBROUTINE sbc_cpl_rcv1597 !1598 SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )1599 REAL(wp), INTENT(out), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2]1600 REAL(wp), INTENT(out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid)1601 p_taui(:,:) = 0. ; p_tauj(:,:) = 0. ! stupid definition to avoid warning message when compiling...1602 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?'1603 END SUBROUTINE sbc_cpl_ice_tau1604 !1605 SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi , psst , pist )1606 REAL(wp), INTENT(in ), DIMENSION(:,: ) :: p_frld ! lead fraction [0 to 1]1607 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! ice albedo1608 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celcius]1609 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin]1610 WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1), palbi(1,1,1), psst(1,1), pist(1,1,1)1611 END SUBROUTINE sbc_cpl_ice_flx1612 1613 #endif1614 1615 1558 !!====================================================================== 1616 1559 END MODULE sbccpl -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r4897 r4901 95 95 END FUNCTION sbc_ice_cice_alloc 96 96 97 SUBROUTINE sbc_ice_cice( kt, nsbc )97 SUBROUTINE sbc_ice_cice( kt, ksbc ) 98 98 !!--------------------------------------------------------------------- 99 99 !! *** ROUTINE sbc_ice_cice *** … … 113 113 !!--------------------------------------------------------------------- 114 114 INTEGER, INTENT(in) :: kt ! ocean time step 115 INTEGER, INTENT(in) :: nsbc ! surface forcing type115 INTEGER, INTENT(in) :: ksbc ! surface forcing type 116 116 !!---------------------------------------------------------------------- 117 117 ! … … 123 123 124 124 ! Make sure any fluxes required for CICE are set 125 IF ( nsbc == 2 )THEN125 IF ( ksbc == jp_flx ) THEN 126 126 CALL cice_sbc_force(kt) 127 ELSE IF ( nsbc == 5) THEN127 ELSE IF ( ksbc == jp_cpl ) THEN 128 128 CALL sbc_cpl_ice_flx( 1.0-fr_i ) 129 129 ENDIF 130 130 131 CALL cice_sbc_in ( kt, nsbc )131 CALL cice_sbc_in ( kt, ksbc ) 132 132 CALL CICE_Run 133 CALL cice_sbc_out ( kt, nsbc )134 135 IF ( nsbc == 5) CALL cice_sbc_hadgam(kt+1)133 CALL cice_sbc_out ( kt, ksbc ) 134 135 IF ( ksbc == jp_cpl ) CALL cice_sbc_hadgam(kt+1) 136 136 137 137 ENDIF ! End sea-ice time step only … … 141 141 END SUBROUTINE sbc_ice_cice 142 142 143 SUBROUTINE cice_sbc_init ( nsbc)143 SUBROUTINE cice_sbc_init (ksbc) 144 144 !!--------------------------------------------------------------------- 145 145 !! *** ROUTINE cice_sbc_init *** 146 146 !! ** Purpose: Initialise ice related fields for NEMO and coupling 147 147 !! 148 INTEGER, INTENT( in ) :: nsbc ! surface forcing type148 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 149 149 REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 150 150 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar … … 165 165 166 166 ! Do some CICE consistency checks 167 IF ( ( nsbc == 2) .OR. (nsbc == 5) ) THEN167 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 168 168 IF ( calc_strair .OR. calc_Tsfc ) THEN 169 169 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 170 170 ENDIF 171 ELSEIF ( nsbc == 4) THEN171 ELSEIF (ksbc == jp_core) THEN 172 172 IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN 173 173 CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' ) … … 190 190 191 191 CALL cice2nemo(aice,fr_i, 'T', 1. ) 192 IF ( ( nsbc == 2).OR.(nsbc == 5) ) THEN192 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_cpl) ) THEN 193 193 DO jl=1,ncat 194 194 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 232 232 233 233 234 SUBROUTINE cice_sbc_in (kt, nsbc)234 SUBROUTINE cice_sbc_in (kt, ksbc) 235 235 !!--------------------------------------------------------------------- 236 236 !! *** ROUTINE cice_sbc_in *** … … 238 238 !!--------------------------------------------------------------------- 239 239 INTEGER, INTENT(in ) :: kt ! ocean time step 240 INTEGER, INTENT(in ) :: nsbc ! surface forcing type240 INTEGER, INTENT(in ) :: ksbc ! surface forcing type 241 241 242 242 INTEGER :: ji, jj, jl ! dummy loop indices … … 262 262 ! forced and coupled case 263 263 264 IF ( ( nsbc == 2).OR.(nsbc == 5) ) THEN264 IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 265 265 266 266 ztmpn(:,:,:)=0.0 … … 287 287 288 288 ! Surface downward latent heat flux (CI_5) 289 IF ( nsbc == 2) THEN289 IF (ksbc == jp_flx) THEN 290 290 DO jl=1,ncat 291 291 ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) … … 316 316 ! GBM conductive flux through ice (CI_6) 317 317 ! Convert to GBM 318 IF ( nsbc == 2) THEN318 IF (ksbc == jp_flx) THEN 319 319 ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 320 320 ELSE … … 325 325 ! GBM surface heat flux (CI_7) 326 326 ! Convert to GBM 327 IF ( nsbc == 2) THEN327 IF (ksbc == jp_flx) THEN 328 328 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 329 329 ELSE … … 333 333 ENDDO 334 334 335 ELSE IF ( nsbc == 4) THEN335 ELSE IF (ksbc == jp_core) THEN 336 336 337 337 ! Pass CORE forcing fields to CICE (which will calculate heat fluxes etc itself) … … 458 458 459 459 460 SUBROUTINE cice_sbc_out (kt, nsbc)460 SUBROUTINE cice_sbc_out (kt,ksbc) 461 461 !!--------------------------------------------------------------------- 462 462 !! *** ROUTINE cice_sbc_out *** … … 464 464 !!--------------------------------------------------------------------- 465 465 INTEGER, INTENT( in ) :: kt ! ocean time step 466 INTEGER, INTENT( in ) :: nsbc ! surface forcing type466 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 467 467 468 468 INTEGER :: ji, jj, jl ! dummy loop indices … … 510 510 ! Freshwater fluxes 511 511 512 IF ( nsbc == 2) THEN512 IF (ksbc == jp_flx) THEN 513 513 ! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip) 514 514 ! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below … … 516 516 ! Better to use evap and tprecip? (but for now don't read in evap in this case) 517 517 emp(:,:) = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 518 ELSE IF ( nsbc == 4) THEN518 ELSE IF (ksbc == jp_core) THEN 519 519 emp(:,:) = (1.0-fr_i(:,:))*emp(:,:) 520 ELSE IF ( nsbc ==5) THEN520 ELSE IF (ksbc == jp_cpl) THEN 521 521 ! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above) 522 522 ! This is currently as required with the coupling fields from the UM atmosphere … … 543 543 ! Scale qsr and qns according to ice fraction (bulk formulae only) 544 544 545 IF ( nsbc == 4) THEN545 IF (ksbc == jp_core) THEN 546 546 qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:)) 547 547 qns(:,:)=qns(:,:)*(1.0-fr_i(:,:)) 548 548 ENDIF 549 549 ! Take into account snow melting except for fully coupled when already in qns_tot 550 IF ( nsbc == 5) THEN550 IF (ksbc == jp_cpl) THEN 551 551 qsr(:,:)= qsr_tot(:,:) 552 552 qns(:,:)= qns_tot(:,:) … … 575 575 576 576 CALL cice2nemo(aice,fr_i,'T', 1. ) 577 IF ( ( nsbc == 2).OR.(nsbc == 5) ) THEN577 IF ( (ksbc == jp_flx).OR.(ksbc == jp_cpl) ) THEN 578 578 DO jl=1,ncat 579 579 CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) … … 611 611 612 612 613 #if defined key_oasis3 || defined key_oasis4614 613 SUBROUTINE cice_sbc_hadgam( kt ) 615 614 !!--------------------------------------------------------------------- … … 653 652 END SUBROUTINE cice_sbc_hadgam 654 653 655 #else656 SUBROUTINE cice_sbc_hadgam( kt ) ! Dummy routine657 INTEGER, INTENT( in ) :: kt ! ocean time step658 WRITE(*,*) 'cice_sbc_hadgam: You should not have seen this print! error?'659 END SUBROUTINE cice_sbc_hadgam660 #endif661 654 662 655 SUBROUTINE cice_sbc_final … … 1001 994 CONTAINS 1002 995 1003 SUBROUTINE sbc_ice_cice ( kt, nsbc ) ! Dummy routine996 SUBROUTINE sbc_ice_cice ( kt, ksbc ) ! Dummy routine 1004 997 WRITE(*,*) 'sbc_ice_cice: You should not have seen this print! error?', kt 1005 998 END SUBROUTINE sbc_ice_cice 1006 999 1007 SUBROUTINE cice_sbc_init ( nsbc) ! Dummy routine1000 SUBROUTINE cice_sbc_init (ksbc) ! Dummy routine 1008 1001 WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?' 1009 1002 END SUBROUTINE cice_sbc_init -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
r4897 r4901 16 16 USE eosbn2 ! equation of state 17 17 USE sbc_oce ! surface boundary condition: ocean fields 18 USE sbccpl 18 #if defined key_lim3 19 USE ice , ONLY : a_i 20 #else 21 USE sbc_ice, ONLY : a_i 22 #endif 19 23 USE fldread ! read input field 20 24 USE iom ! I/O manager library … … 101 105 fr_i(:,:) = eos_fzp( sss_m ) * tmask(:,:,1) ! sea surface freezing temperature [Celcius] 102 106 103 !!OM : probleme. a_i pas defini dans les cas lim3 et cice 104 !!gm Not sure at all that a_i should be defined.... ==>>> to be checked 105 #if defined key_coupled && defined key_lim2 106 a_i(:,:,1) = fr_i(:,:) 107 #endif 107 IF( lk_cpl ) a_i(:,:,1) = fr_i(:,:) 108 108 109 109 ! Flux and ice fraction computation -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r4897 r4901 93 93 !! 94 94 INTEGER :: ji, jj ! dummy loop indices 95 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_os ! albedo of the ice under overcast sky 96 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_cs ! albedo of ice under clear sky 97 REAL(wp), DIMENSION(:,:,:), POINTER :: zsist ! surface ice temperature (K) 95 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_os ! ice albedo under overcast sky 96 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_cs ! ice albedo under clear sky 97 REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice ! mean ice albedo 98 REAL(wp), DIMENSION(:,:,:), POINTER :: zsist ! ice surface temperature (K) 98 99 !!---------------------------------------------------------------------- 99 100 100 CALL wrk_alloc( jpi,jpj,1, zalb_ ice_os, zalb_ice_cs, zsist )101 CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 101 102 102 103 IF( kt == nit000 ) THEN … … 144 145 zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) ) 145 146 146 ! ... ice albedo (clear sky and overcast sky) 147 ! Ice albedo 148 147 149 CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), & 148 150 reshape( hsnif, (/jpi,jpj,1/) ), & 149 zalb_ice_cs, zalb_ice_os ) 151 zalb_cs, zalb_os ) 152 153 SELECT CASE( ksbc ) 154 CASE( jp_core , jp_cpl ) ! CORE and COUPLED bulk formulations 155 156 ! albedo depends on cloud fraction because of non-linear spectral effects 157 zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:) 158 ! In CLIO the cloud fraction is read in the climatology and the all-sky albedo 159 ! (zalb_ice) is computed within the bulk routine 160 161 END SELECT 150 162 151 163 ! ... Sea-ice surface boundary conditions output from bulk formulae : … … 163 175 ! 164 176 SELECT CASE( ksbc ) 165 CASE( 3) ! CLIO bulk formulation166 CALL blk_ice_clio( zsist, zalb_ ice_cs, zalb_ice_os,&177 CASE( jp_clio ) ! CLIO bulk formulation 178 CALL blk_ice_clio( zsist, zalb_cs , zalb_os , zalb_ice , & 167 179 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 168 180 & qla_ice , dqns_ice , dqla_ice , & … … 170 182 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 171 183 172 CASE( 4) ! CORE bulk formulation173 CALL blk_ice_core( zsist, u_ice , v_ice , zalb_ice _cs, &184 CASE( jp_core ) ! CORE bulk formulation 185 CALL blk_ice_core( zsist, u_ice , v_ice , zalb_ice , & 174 186 & utau_ice , vtau_ice , qns_ice , qsr_ice, & 175 187 & qla_ice , dqns_ice , dqla_ice , & 176 188 & tprecip , sprecip , & 177 189 & fr1_i0 , fr2_i0 , cp_ice_msh , jpl ) 178 IF( ltrcdm2dc_ice ) CALL blk_ice_meanqsr( zalb_ice _cs, qsr_ice_mean, jpl )179 180 CASE( 5 )! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)190 IF( ltrcdm2dc_ice ) CALL blk_ice_meanqsr( zalb_ice, qsr_ice_mean, jpl ) 191 192 CASE( jp_cpl ) ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics) 181 193 CALL sbc_cpl_ice_tau( utau_ice , vtau_ice ) 182 194 END SELECT … … 206 218 IF( ln_limdmp ) CALL lim_dmp_2 ( kt ) ! Ice damping 207 219 END IF 208 #if defined key_coupled209 220 ! ! Ice surface fluxes in coupled mode 210 IF( ksbc == 5) THEN221 IF( ksbc == jp_cpl ) THEN 211 222 a_i(:,:,1)=fr_i 212 223 CALL sbc_cpl_ice_flx( frld, & 213 224 ! optional arguments, used only in 'mixed oce-ice' case 214 & palbi = zalb_ice _cs, psst = sst_m, pist = zsist )225 & palbi = zalb_ice, psst = sst_m, pist = zsist ) 215 226 sprecip(:,:) = - emp_ice(:,:) ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.) 216 227 ENDIF 217 #endif218 228 CALL lim_thd_2 ( kt ) ! Ice thermodynamics 219 229 CALL lim_sbc_flx_2 ( kt ) ! update surface ocean mass, heat & salt fluxes … … 245 255 IF( ln_limdyn ) CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents 246 256 ! 247 CALL wrk_dealloc( jpi,jpj,1, zalb_ ice_os, zalb_ice_cs, zsist )257 CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist ) 248 258 ! 249 259 END SUBROUTINE sbc_ice_lim_2 -
branches/2014/dev_CNRS_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r4897 r4901 37 37 USE sbcice_cice ! surface boundary condition: CICE sea-ice model 38 38 USE sbccpl ! surface boundary condition: coupled florulation 39 USE cpl_oasis3, ONLY:lk_cpl ! are we in coupled mode?40 39 USE sbcssr ! surface boundary condition: sea surface restoring 41 40 USE sbcrnf ! surface boundary condition: runoffs … … 82 81 INTEGER :: icpt ! local integer 83 82 !! 84 NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, ln_cpl,&83 NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, & 85 84 & ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc , ln_rnf, & 86 & ln_ssr , nn_fwb , ln_cdgw , ln_wave , ln_sdw, nn_lsm, cn_iceflx85 & ln_ssr , nn_fwb , ln_cdgw , ln_wave , ln_sdw, nn_lsm, nn_limflx 87 86 INTEGER :: ios 88 87 !!---------------------------------------------------------------------- … … 123 122 WRITE(numout,*) ' CORE bulk formulation ln_blk_core = ', ln_blk_core 124 123 WRITE(numout,*) ' MFS bulk formulation ln_blk_mfs = ', ln_blk_mfs 125 WRITE(numout,*) ' coupled formulation (T if key_ sbc_cpl) ln_cpl = ', ln_cpl126 WRITE(numout,*) ' Flux handling over ice categories cn_iceflx = ', TRIM (cn_iceflx)124 WRITE(numout,*) ' coupled formulation (T if key_oasis3) lk_cpl = ', lk_cpl 125 WRITE(numout,*) ' Multicategory heat flux formulation (LIM3) nn_limflx = ', nn_limflx 127 126 WRITE(numout,*) ' Misc. options of sbc : ' 128 127 WRITE(numout,*) ' Patm gradient added in ocean & ice Eqs. ln_apr_dyn = ', ln_apr_dyn … … 137 136 ENDIF 138 137 139 ! Flux handling over ice categories 140 #if defined key_coupled 141 SELECT CASE ( TRIM (cn_iceflx)) 142 CASE ('ave') 143 ln_iceflx_ave = .TRUE. 144 ln_iceflx_linear = .FALSE. 145 CASE ('linear') 146 ln_iceflx_ave = .FALSE. 147 ln_iceflx_linear = .TRUE. 148 CASE default 149 ln_iceflx_ave = .FALSE. 150 ln_iceflx_linear = .FALSE. 138 ! LIM3 Multi-category heat flux formulation 139 SELECT CASE ( nn_limflx) 140 CASE ( -1 ) 141 IF(lwp) WRITE(numout,*) ' Use of per-category fluxes (nn_limflx = -1) ' 142 CASE ( 0 ) 143 IF(lwp) WRITE(numout,*) ' Average per-category fluxes (nn_limflx = 0) ' 144 CASE ( 1 ) 145 IF(lwp) WRITE(numout,*) ' Average then redistribute per-category fluxes (nn_limflx = 1) ' 146 CASE ( 2 ) 147 IF(lwp) WRITE(numout,*) ' Redistribute a single flux over categories (nn_limflx = 2) ' 151 148 END SELECT 152 IF(lwp) WRITE(numout,*) ' Fluxes averaged over all ice categories ln_iceflx_ave = ', ln_iceflx_ave153 IF(lwp) WRITE(numout,*) ' Fluxes distributed linearly over ice categories ln_iceflx_linear = ', ln_iceflx_linear154 #endif155 149 ! 156 150 #if defined key_top && ! defined key_offline … … 206 200 IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 ) & 207 201 & CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 1 or 2' ) 208 #if defined key_coupled 209 IF( ln_iceflx_ave .AND. ln_iceflx_linear ) & 210 & CALL ctl_stop( ' ln_iceflx_ave and ln_iceflx_linear options are not compatible' ) 211 IF( ( nn_ice ==3 .AND. lk_cpl) .AND. .NOT. ( ln_iceflx_ave .OR. ln_iceflx_linear ) ) & 212 & CALL ctl_stop( ' With lim3 coupled, either ln_iceflx_ave or ln_iceflx_linear must be set to .TRUE.' ) 213 #endif 202 IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) ) & 203 & WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3' 204 IF( ( nn_ice == 3 ) .AND. ( lk_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) ) & 205 & CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' ) 206 IF( ( nn_ice == 3 ) .AND. ( .NOT. lk_cpl ) .AND. ( nn_limflx == 2 ) ) & 207 & CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' ) 208 214 209 IF( ln_dm2dc ) nday_qsr = -1 ! initialisation flag 215 210 … … 236 231 ! ! Choice of the Surface Boudary Condition (set nsbc) 237 232 icpt = 0 238 IF( ln_ana ) THEN ; nsbc = 1; icpt = icpt + 1 ; ENDIF ! analytical formulation239 IF( ln_flx ) THEN ; nsbc = 2; icpt = icpt + 1 ; ENDIF ! flux formulation240 IF( ln_blk_clio ) THEN ; nsbc = 3; icpt = icpt + 1 ; ENDIF ! CLIO bulk formulation241 IF( ln_blk_core ) THEN ; nsbc = 4; icpt = icpt + 1 ; ENDIF ! CORE bulk formulation242 IF( ln_blk_mfs ) THEN ; nsbc = 6; icpt = icpt + 1 ; ENDIF ! MFS bulk formulation243 IF( l n_cpl ) THEN ; nsbc = 5; icpt = icpt + 1 ; ENDIF ! Coupled formulation244 IF( cp_cfg == 'gyre') THEN ; nsbc = 0; ENDIF ! GYRE analytical formulation245 IF( lk_esopa ) nsbc = -1! esopa test, ALL formulations233 IF( ln_ana ) THEN ; nsbc = jp_ana ; icpt = icpt + 1 ; ENDIF ! analytical formulation 234 IF( ln_flx ) THEN ; nsbc = jp_flx ; icpt = icpt + 1 ; ENDIF ! flux formulation 235 IF( ln_blk_clio ) THEN ; nsbc = jp_clio ; icpt = icpt + 1 ; ENDIF ! CLIO bulk formulation 236 IF( ln_blk_core ) THEN ; nsbc = jp_core ; icpt = icpt + 1 ; ENDIF ! CORE bulk formulation 237 IF( ln_blk_mfs ) THEN ; nsbc = jp_mfs ; icpt = icpt + 1 ; ENDIF ! MFS bulk formulation 238 IF( lk_cpl ) THEN ; nsbc = jp_cpl ; icpt = icpt + 1 ; ENDIF ! Coupled formulation 239 IF( cp_cfg == 'gyre') THEN ; nsbc = jp_gyre ; ENDIF ! GYRE analytical formulation 240 IF( lk_esopa ) nsbc = jp_esopa ! esopa test, ALL formulations 246 241 ! 247 242 IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN … … 254 249 IF(lwp) THEN 255 250 WRITE(numout,*) 256 IF( nsbc == -1 ) WRITE(numout,*) ' ESOPA test All surface boundary conditions' 257 IF( nsbc == 0 ) WRITE(numout,*) ' GYRE analytical formulation' 258 IF( nsbc == 1 ) WRITE(numout,*) ' analytical formulation' 259 IF( nsbc == 2 ) WRITE(numout,*) ' flux formulation' 260 IF( nsbc == 3 ) WRITE(numout,*) ' CLIO bulk formulation' 261 IF( nsbc == 4 ) WRITE(numout,*) ' CORE bulk formulation' 262 IF( nsbc == 5 ) WRITE(numout,*) ' coupled formulation' 263 IF( nsbc == 6 ) WRITE(numout,*) ' MFS Bulk formulation' 264 ENDIF 265 ! 266 CALL sbc_ssm_init ! Sea-surface mean fields initialisation 267 ! 268 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialisation 269 ! 270 IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialisation 271 ! 251 IF( nsbc == jp_esopa ) WRITE(numout,*) ' ESOPA test All surface boundary conditions' 252 IF( nsbc == jp_gyre ) WRITE(numout,*) ' GYRE analytical formulation' 253 IF( nsbc == jp_ana ) WRITE(numout,*) ' analytical formulation' 254 IF( nsbc == jp_flx ) WRITE(numout,*) ' flux formulation' 255 IF( nsbc == jp_clio ) WRITE(numout,*) ' CLIO bulk formulation' 256 IF( nsbc == jp_core ) WRITE(numout,*) ' CORE bulk formulation' 257 IF( nsbc == jp_cpl ) WRITE(numout,*) ' coupled formulation' 258 IF( nsbc == jp_mfs ) WRITE(numout,*) ' MFS Bulk formulation' 259 ENDIF 260 ! 261 CALL sbc_ssm_init ! Sea-surface mean fields initialisation 262 ! 263 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialisation 264 ! 265 IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialisation 266 ! 267 IF( nsbc == jp_cpl ) CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before first time step 268 272 269 END SUBROUTINE sbc_init 273 270 … … 320 317 SELECT CASE( nsbc ) ! Compute ocean surface boundary condition 321 318 ! ! (i.e. utau,vtau, qns, qsr, emp, sfx) 322 CASE( 0) ; CALL sbc_gyre ( kt ) ! analytical formulation : GYRE configuration323 CASE( 1) ; CALL sbc_ana ( kt ) ! analytical formulation : uniform sbc324 CASE( 2) ; CALL sbc_flx ( kt ) ! flux formulation325 CASE( 3) ; CALL sbc_blk_clio( kt ) ! bulk formulation : CLIO for the ocean326 CASE( 4) ; CALL sbc_blk_core( kt ) ! bulk formulation : CORE for the ocean327 CASE( 5) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! coupled formulation328 CASE( 6) ; CALL sbc_blk_mfs ( kt ) ! bulk formulation : MFS for the ocean329 CASE( -1)330 CALL sbc_ana ( kt ) ! ESOPA, test ALL the formulations331 CALL sbc_gyre ( kt ) !332 CALL sbc_flx ( kt ) !333 CALL sbc_blk_clio( kt ) !334 CALL sbc_blk_core( kt ) !335 CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) !319 CASE( jp_gyre ) ; CALL sbc_gyre ( kt ) ! analytical formulation : GYRE configuration 320 CASE( jp_ana ) ; CALL sbc_ana ( kt ) ! analytical formulation : uniform sbc 321 CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation 322 CASE( jp_clio ) ; CALL sbc_blk_clio( kt ) ! bulk formulation : CLIO for the ocean 323 CASE( jp_core ) ; CALL sbc_blk_core( kt ) ! bulk formulation : CORE for the ocean 324 CASE( jp_cpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! coupled formulation 325 CASE( jp_mfs ) ; CALL sbc_blk_mfs ( kt ) ! bulk formulation : MFS for the ocean 326 CASE( jp_esopa ) 327 CALL sbc_ana ( kt ) ! ESOPA, test ALL the formulations 328 CALL sbc_gyre ( kt ) ! 329 CALL sbc_flx ( kt ) ! 330 CALL sbc_blk_clio( kt ) ! 331 CALL sbc_blk_core( kt ) ! 332 CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! 336 333 END SELECT 337 334 … … 342 339 CASE( 2 ) ; CALL sbc_ice_lim_2( kt, nsbc ) ! LIM-2 ice model 343 340 CASE( 3 ) ; CALL sbc_ice_lim ( kt, nsbc ) ! LIM-3 ice model 344 !is it useful?345 341 CASE( 4 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model 346 342 END SELECT … … 414 410 CALL iom_put( "qsr" , qsr ) ! solar heat flux 415 411 IF( nn_ice > 0 ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction 412 CALL iom_put( "taum" , taum ) ! wind stress module 413 CALL iom_put( "wspd" , wndm ) ! wind speed module over free ocean or leads in presence of sea-ice 416 414 ENDIF 417 415 ! 418 416 CALL iom_put( "utau", utau ) ! i-wind stress (stress can be updated at 419 417 CALL iom_put( "vtau", vtau ) ! j-wind stress each time step in sea-ice) 420 CALL iom_put( "taum", taum ) ! wind stress module421 CALL iom_put( "wspd", wndm ) ! wind speed module422 418 ! 423 419 IF(ln_ctl) THEN ! print mean trends (used for debugging)
Note: See TracChangeset
for help on using the changeset viewer.