Changeset 7483 for branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2016-12-10T14:27:17+01:00 (8 years ago)
- Location:
- branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 17 edited
-
C1D/step_c1d.F90 (modified) (1 diff)
-
DIA/diaar5.F90 (modified) (4 diffs)
-
DIA/diahsb.F90 (modified) (13 diffs)
-
DOM/closea.F90 (modified) (1 diff)
-
DYN/dynvor.F90 (modified) (2 diffs)
-
DYN/dynzdf_imp.F90 (modified) (1 diff)
-
ICB/icbini.F90 (modified) (5 diffs)
-
LBC/lbcnfd.F90 (modified) (4 diffs)
-
LBC/lib_mpp.F90 (modified) (1 diff)
-
LDF/ldfeiv.F90 (modified) (1 diff)
-
SBC/sbcblk_core.F90 (modified) (1 diff)
-
SBC/sbccpl.F90 (modified) (16 diffs)
-
SBC/sbcice_lim.F90 (modified) (2 diffs)
-
TRA/traadv_tvd.F90 (modified) (5 diffs)
-
TRA/trasbc.F90 (modified) (1 diff)
-
ZDF/zdfric.F90 (modified) (1 diff)
-
step.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
r5412 r7483 60 60 61 61 indic = 0 ! reset to no error condition 62 IF( kstp == nit000 ) CALL iom_init( "nemo") ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)62 IF( kstp == nit000 ) CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 63 63 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 64 CALL iom_setkt( kstp - nit000 + 1, "nemo") ! say to iom that we are at time step kstp64 CALL iom_setkt( kstp - nit000 + 1, cxios_context ) ! say to iom that we are at time step kstp 65 65 66 66 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r5253 r7483 211 211 REAL(wp) :: zztmp 212 212 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 213 ! reading initial file214 LOGICAL :: ln_tsd_init !: T & S data flag215 LOGICAL :: ln_tsd_tradmp !: internal damping toward input data flag216 CHARACTER(len=100) :: cn_dir217 TYPE(FLD_N) :: sn_tem,sn_sal218 INTEGER :: ios=0219 220 NAMELIST/namtsd/ ln_tsd_init,ln_tsd_tradmp,cn_dir,sn_tem,sn_sal221 !222 223 REWIND( numnam_ref ) ! Namelist namtsd in reference namelist :224 READ ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901)225 901 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in reference namelist for dia_ar5', lwp )226 REWIND( numnam_cfg ) ! Namelist namtsd in configuration namelist : Parameters of the run227 READ ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 )228 902 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in configuration namelist for dia_ar5', lwp )229 IF(lwm) WRITE ( numond, namtsd )230 213 ! 231 214 !!---------------------------------------------------------------------- … … 233 216 IF( nn_timing == 1 ) CALL timing_start('dia_ar5_init') 234 217 ! 235 CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta )218 CALL wrk_alloc( jpi, jpj, jpk, 2, zsaldta ) 236 219 ! ! allocate dia_ar5 arrays 237 220 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) … … 249 232 IF( lk_mpp ) CALL mpp_sum( vol0 ) 250 233 251 CALL iom_open ( TRIM( cn_dir )//TRIM(sn_sal%clname), inum )252 CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,1), 1 )253 CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,2), 12 )234 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 235 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) 236 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 254 237 CALL iom_close( inum ) 238 255 239 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 256 240 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) … … 267 251 ENDIF 268 252 ! 269 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta )253 CALL wrk_dealloc( jpi, jpj, jpk, 2, zsaldta ) 270 254 ! 271 255 IF( nn_timing == 1 ) CALL timing_stop('dia_ar5_init') -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r5628 r7483 38 38 PUBLIC dia_hsb ! routine called by step.F90 39 39 PUBLIC dia_hsb_init ! routine called by nemogcm.F90 40 PUBLIC dia_hsb_rst ! routine called by step.F9041 40 42 41 LOGICAL, PUBLIC :: ln_diahsb !: check the heat and salt budgets … … 86 85 !!--------------------------------------------------------------------------- 87 86 IF( nn_timing == 1 ) CALL timing_start('dia_hsb') 87 ! 88 88 CALL wrk_alloc( jpi,jpj, z2d0, z2d1 ) 89 89 ! … … 174 174 ENDDO 175 175 176 ! Substract forcing from heat content, salt content and volume variations 176 ! ------------------------ ! 177 ! 3 - Drifts ! 178 ! ------------------------ ! 177 179 zdiff_v1 = zdiff_v1 - frc_v 178 180 IF( lk_vvl ) zdiff_v2 = zdiff_v2 - frc_v … … 187 189 188 190 ! ----------------------- ! 189 ! 3- Diagnostics writing !191 ! 4 - Diagnostics writing ! 190 192 ! ----------------------- ! 191 193 zvol_tot = 0._wp ! total ocean volume (calculated with scale factors) … … 200 202 !!gm end 201 203 204 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 205 CALL iom_put( 'bgfrctem' , frc_t * rau0 * rcp * 1.e-20 ) ! hc - surface forcing (1.e20 J) 206 CALL iom_put( 'bgfrchfx' , frc_t * rau0 * rcp / & ! hc - surface forcing (W/m2) 207 & ( surf_tot * kt * rdt ) ) 208 CALL iom_put( 'bgfrcsal' , frc_s * 1.e-9 ) ! sc - surface forcing (psu*km3) 209 202 210 IF( lk_vvl ) THEN 203 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature variation (C) 204 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity variation (psu) 205 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp ) ! Heat content variation (1.e20 J) 206 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content variation (psu*km3) 207 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh variation (km3) 208 CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t variation (km3) 209 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 210 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C) 211 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu) 211 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature drift (C) 212 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity drift (pss) 213 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rau0 * rcp ) ! Heat content drift (1.e20 J) 214 CALL iom_put( 'bgheatfx' , zdiff_hc * rau0 * rcp / & ! Heat flux drift (W/m2) 215 & ( surf_tot * kt * rdt ) ) 216 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content drift (psu*km3) 217 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 218 CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t drift (km3) 212 219 ELSE 213 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content variation (C) 214 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content variation (psu) 215 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp ) ! Heat content variation (1.e20 J) 216 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content variation (psu*km3) 217 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh variation (km3) 218 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 219 CALL iom_put( 'bgfrctem' , frc_t / zvol_tot ) ! hc - surface forcing (C) 220 CALL iom_put( 'bgfrcsal' , frc_s / zvol_tot ) ! sc - surface forcing (psu) 220 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content drift (C) 221 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content drift (pss) 222 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rau0 * rcp ) ! Heat content drift (1.e20 J) 223 CALL iom_put( 'bgheatfx' , zdiff_hc1 * rau0 * rcp / & ! Heat flux drift (W/m2) 224 & ( surf_tot * kt * rdt ) ) 225 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content drift (psu*km3) 226 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 221 227 CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot ) ! hc - error due to free surface (C) 222 228 CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot ) ! sc - error due to free surface (psu) … … 244 250 ! 245 251 INTEGER :: ji, jj, jk ! dummy loop indices 246 INTEGER :: id1 ! local integers247 252 !!---------------------------------------------------------------------- 248 253 ! 249 254 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 250 255 IF( ln_rstart ) THEN !* Read the restart file 251 !id1 = iom_varid( numror, 'frc_vol' , ldstop = .FALSE. )252 256 ! 253 257 IF(lwp) WRITE(numout,*) '~~~~~~~' … … 261 265 CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 262 266 ENDIF 263 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini )264 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini )265 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini )266 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini )267 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:) ) 268 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:) ) 269 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 270 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 267 271 IF( .NOT. lk_vvl ) THEN 268 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini )269 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini )272 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 273 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 270 274 ENDIF 271 275 ELSE … … 312 316 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 313 317 ENDIF 314 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini )315 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini )316 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini )317 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini )318 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini(:,:) ) 319 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini(:,:,:) ) 320 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 321 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 318 322 IF( .NOT. lk_vvl ) THEN 319 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini )320 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini )323 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 324 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 321 325 ENDIF 326 322 327 ! 323 328 ENDIF … … 338 343 !! - Compute coefficients for conversion 339 344 !!--------------------------------------------------------------------------- 340 INTEGER :: jk ! dummy loop indice341 345 INTEGER :: ierror ! local integer 342 346 INTEGER :: ios … … 344 348 NAMELIST/namhsb/ ln_diahsb 345 349 !!---------------------------------------------------------------------- 346 347 IF(lwp) THEN348 WRITE(numout,*)349 WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets'350 WRITE(numout,*) '~~~~~~~~ '351 ENDIF352 350 353 351 REWIND( numnam_ref ) ! Namelist namhsb in reference namelist … … 360 358 IF(lwm) WRITE ( numond, namhsb ) 361 359 362 ! 363 IF(lwp) THEN ! Control print 360 IF(lwp) THEN 364 361 WRITE(numout,*) 365 WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets' 366 WRITE(numout,*) '~~~~~~~~~~~~' 367 WRITE(numout,*) ' Namelist namhsb : set hsb parameters' 368 WRITE(numout,*) ' Switch for hsb diagnostic (T) or not (F) ln_diahsb = ', ln_diahsb 369 WRITE(numout,*) 370 ENDIF 371 362 WRITE(numout,*) 'dia_hsb_init' 363 WRITE(numout,*) '~~~~~~~~ ' 364 WRITE(numout,*) ' check the heat and salt budgets (T) or not (F) ln_diahsb = ', ln_diahsb 365 ENDIF 366 ! 372 367 IF( .NOT. ln_diahsb ) RETURN 373 368 ! IF( .NOT. lk_mpp_rep ) & … … 382 377 & e3t_ini(jpi,jpj,jpk), surf(jpi,jpj), ssh_ini(jpi,jpj), STAT=ierror ) 383 378 IF( ierror > 0 ) THEN 384 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN 385 ENDIF 386 387 IF(.NOT. lk_vvl ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror ) 388 IF( ierror > 0 ) THEN 389 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN 379 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) 380 RETURN 381 ENDIF 382 383 IF( .NOT. lk_vvl ) THEN 384 ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj), STAT=ierror ) 385 IF( ierror > 0 ) THEN 386 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) 387 RETURN 388 ENDIF 390 389 ENDIF 391 390 … … 393 392 ! 2 - Time independant variables and file opening ! 394 393 ! ----------------------------------------------- ! 395 IF(lwp) WRITE(numout,*) "dia_hsb: heat salt volume budgets activated"396 IF(lwp) WRITE(numout,*) '~~~~~~~'397 394 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area 398 surf_tot = glob_sum( surf(:,:) ) 395 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area 399 396 400 397 IF( lk_bdy ) CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' ) -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
r5506 r7483 158 158 CASE ( 025 ) ! ORCA_R025 configuration 159 159 ! ! ======================= 160 isrow = 1207 - jpjglo ! eORCA025 R025 - Using full isfextended 161 ! domain for reference. - Adjust jindices 160 162 ncsnr(1) = 1 ; ncstt(1) = 0 ! Caspian + Aral sea 161 ncsi1(1) = 1330 ; ncsj1(1) = 645162 ncsi2(1) = 1400 ; ncsj2(1) = 795163 ncsi1(1) = 1330 ; ncsj1(1) = 831 - isrow 164 ncsi2(1) = 1400 ; ncsj2(1) = 981 - isrow 163 165 ncsir(1,1) = 1 ; ncsjr(1,1) = 1 164 166 ! 165 167 ncsnr(2) = 1 ; ncstt(2) = 0 ! Azov Sea 166 ncsi1(2) = 1284 ; ncsj1(2) = 722167 ncsi2(2) = 1304 ; ncsj2(2) = 747168 ncsi1(2) = 1284 ; ncsj1(2) = 908 - isrow 169 ncsi2(2) = 1304 ; ncsj2(2) = 933 - isrow 168 170 ncsir(2,1) = 1 ; ncsjr(2,1) = 1 171 ! 172 ncsnr(3) = 1 ; ncstt(3) = 0 ! Great Lakes 173 ncsi1(3) = 775 ; ncsj1(3) = 866 - isrow 174 ncsi2(3) = 848 ; ncsj2(3) = 931 - isrow 175 ncsir(3,1) = 1 ; ncsjr(3,1) = 1 176 ! 177 ncsnr(4) = 1 ; ncstt(4) = 0 ! Lake Victoria 178 ncsi1(4) = 1270 ; ncsj1(4) = 661 - isrow 179 ncsi2(4) = 1295 ; ncsj2(4) = 696 - isrow 180 ncsir(4,1) = 1 ; ncsjr(4,1) = 1 181 ! 169 182 ! 170 183 END SELECT -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r5029 r7483 601 601 DO jk = 1, jpk 602 602 DO jj = 1, jpjm1 603 DO ji = 1, jpim1603 DO ji = 1, fs_jpim1 604 604 ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 605 605 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 606 IF( ze3 /= 0._wp ) ze3f(ji,jj,jk) = 4.0_wp / ze3 606 IF ( ze3 /= 0._wp ) THEN ; ze3f(ji,jj,jk) = 4.0_wp / ze3 607 ELSE ; ze3f(ji,jj,jk) = 0.0_wp 608 ENDIF 607 609 END DO 608 610 END DO … … 611 613 DO jk = 1, jpk 612 614 DO jj = 1, jpjm1 613 DO ji = 1, jpim1615 DO ji = 1, fs_jpim1 614 616 ze3 = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 615 617 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) 616 618 zmsk = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 617 619 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) ) 618 IF( ze3 /= 0._wp ) ze3f(ji,jj,jk) = zmsk / ze3 620 IF ( ze3 /= 0._wp ) THEN ; ze3f(ji,jj,jk) = zmsk / ze3 621 ELSE ; ze3f(ji,jj,jk) = 0.0_wp 622 ENDIF 619 623 END DO 620 624 END DO -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r5120 r7483 323 323 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,1) + r_vvl * fse3v_a(ji,jj,1) 324 324 va(ji,jj,1) = va(ji,jj,1) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 325 & / ( ze3va * rau0 ) 325 & / ( ze3va * rau0 ) * vmask(ji,jj,1) 326 326 #else 327 327 va(ji,jj,1) = vb(ji,jj,1) & 328 328 & + p2dt *(va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 329 & / ( fse3v(ji,jj,1) * rau0 ))329 & / ( fse3v(ji,jj,1) * rau0 ) * vmask(ji,jj,1) ) 330 330 #endif 331 331 END DO -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90
r5215 r7483 120 120 ! first entry with narea for this processor is left hand interior index 121 121 ! last entry is right hand interior index 122 jj = jpj/2122 jj = nlcj/2 123 123 nicbdi = -1 124 124 nicbei = -1 … … 136 136 ! 137 137 ! repeat for j direction 138 ji = jpi/2138 ji = nlci/2 139 139 nicbdj = -1 140 140 nicbej = -1 … … 153 153 ! special for east-west boundary exchange we save the destination index 154 154 i1 = MAX( nicbdi-1, 1) 155 i3 = INT( src_calving(i1, jpj/2) )155 i3 = INT( src_calving(i1,nlcj/2) ) 156 156 jj = INT( i3/nicbpack ) 157 157 ricb_left = REAL( i3 - nicbpack*jj, wp ) 158 158 i1 = MIN( nicbei+1, jpi ) 159 i3 = INT( src_calving(i1, jpj/2) )159 i3 = INT( src_calving(i1,nlcj/2) ) 160 160 jj = INT( i3/nicbpack ) 161 161 ricb_right = REAL( i3 - nicbpack*jj, wp ) … … 196 196 WRITE(numicb,*) 'berg left ', ricb_left 197 197 WRITE(numicb,*) 'berg right ', ricb_right 198 jj = jpj/2198 jj = nlcj/2 199 199 WRITE(numicb,*) "central j line:" 200 200 WRITE(numicb,*) "i processor" … … 202 202 WRITE(numicb,*) "i point" 203 203 WRITE(numicb,*) (INT(src_calving(ji,jj)), ji=1,jpi) 204 ji = jpi/2204 ji = nlci/2 205 205 WRITE(numicb,*) "central i line:" 206 206 WRITE(numicb,*) "j processor" -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
r4686 r7483 804 804 ELSE 805 805 startloop = 3 806 pt2dl(2,ijpj) = psgn * pt2d r(3,ijpjm1)806 pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1) 807 807 ENDIF 808 808 DO ji = startloop, nlci … … 816 816 ELSE 817 817 startloop = 3 818 pt2dl(2,ijpj) = psgn * pt2d r(3,ijpjm1)818 pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1) 819 819 ENDIF 820 820 DO ji = startloop, nlci … … 910 910 DO ji = startloop , endloop 911 911 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 912 pt2dl(ji,ijpj)= 0.5 * (pt2d r(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1))912 pt2dl(ji,ijpj)= 0.5 * (pt2dl(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 913 913 END DO 914 914 … … 926 926 DO ji = startloop , endloop 927 927 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 928 pt2dl(ji,ijpj) = pt2d r(ji,ijpjm1)928 pt2dl(ji,ijpj) = pt2dl(ji,ijpjm1) 929 929 END DO 930 930 -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r6476 r7483 2654 2654 !!---------------------------------------------------------------------- 2655 2655 ! 2656 ALLOCATE( ztab(jpiglo,4,num_fields), znorthloc(jpi,4,num_fields), zfoldwk(jpi,4,num_fields), znorthgloio(jpi,4,num_fields,jpni) ) ! expanded to 3 dimensions 2656 ALLOCATE( ztab(jpiglo,4,num_fields), znorthloc(jpi,4,num_fields), zfoldwk(jpi,4,num_fields), & 2657 & znorthgloio(jpi,4,num_fields,jpni) ) ! expanded to 3 dimensions 2657 2658 ALLOCATE( ztabl(jpi,4,num_fields), ztabr(jpi*jpmaxngh, 4,num_fields) ) 2658 2659 ! -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90
r4990 r7483 157 157 END DO 158 158 ENDIF 159 160 ! ORCA R1: Take the minimum between aeiw and aeiv0 161 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN 162 DO jj = 2, jpjm1 163 DO ji = fs_2, fs_jpim1 ! vector opt. 164 aeiw(ji,jj) = MIN( aeiw(ji,jj), aeiv0 ) 165 END DO 166 END DO 167 ENDIF 168 159 169 CALL lbc_lnk( aeiw, 'W', 1. ) ! lateral boundary condition on aeiw 160 170 -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r6399 r7483 206 206 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 207 207 qlw_ice(:,:,1) = sf(jp_qlw)%fnow(:,:,1) 208 qsr_ice(:,:,1) = sf(jp_qsr)%fnow(:,:,1) 208 IF( ln_dm2dc ) THEN ; qsr_ice(:,:,1) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) 209 ELSE ; qsr_ice(:,:,1) = sf(jp_qsr)%fnow(:,:,1) 210 ENDIF 209 211 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) 210 212 qatm_ice(:,:) = sf(jp_humi)%fnow(:,:,1) -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6399 r7483 1335 1335 !! *** ROUTINE sbc_cpl_ice_flx *** 1336 1336 !! 1337 !! ** Purpose : provide the heat and freshwater fluxes of the 1338 !! ocean-ice system. 1337 !! ** Purpose : provide the heat and freshwater fluxes of the ocean-ice system 1339 1338 !! 1340 1339 !! ** Method : transform the fields received from the atmosphere into 1341 1340 !! surface heat and fresh water boundary condition for the 1342 1341 !! ice-ocean system. The following fields are provided: 1343 !! * total non solar, solar and freshwater fluxes (qns_tot,1342 !! * total non solar, solar and freshwater fluxes (qns_tot, 1344 1343 !! qsr_tot and emp_tot) (total means weighted ice-ocean flux) 1345 1344 !! NB: emp_tot include runoffs and calving. 1346 !! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where1345 !! * fluxes over ice (qns_ice, qsr_ice, emp_ice) where 1347 1346 !! emp_ice = sublimation - solid precipitation as liquid 1348 1347 !! precipitation are re-routed directly to the ocean and 1349 !! runoffs and calving directly enter the ocean.1350 !! * solid precipitation (sprecip), used to add to qns_tot1348 !! calving directly enter the ocean (runoffs are read but included in trasbc.F90) 1349 !! * solid precipitation (sprecip), used to add to qns_tot 1351 1350 !! the heat lost associated to melting solid precipitation 1352 1351 !! over the ocean fraction. 1353 !! ===>> CAUTION here this changes the net heat flux received from 1354 !! the atmosphere 1355 !! 1356 !! - the fluxes have been separated from the stress as 1357 !! (a) they are updated at each ice time step compare to 1358 !! an update at each coupled time step for the stress, and 1359 !! (b) the conservative computation of the fluxes over the 1360 !! sea-ice area requires the knowledge of the ice fraction 1361 !! after the ice advection and before the ice thermodynamics, 1362 !! so that the stress is updated before the ice dynamics 1363 !! while the fluxes are updated after it. 1352 !! * heat content of rain, snow and evap can also be provided, 1353 !! otherwise heat flux associated with these mass flux are 1354 !! guessed (qemp_oce, qemp_ice) 1355 !! 1356 !! - the fluxes have been separated from the stress as 1357 !! (a) they are updated at each ice time step compare to 1358 !! an update at each coupled time step for the stress, and 1359 !! (b) the conservative computation of the fluxes over the 1360 !! sea-ice area requires the knowledge of the ice fraction 1361 !! after the ice advection and before the ice thermodynamics, 1362 !! so that the stress is updated before the ice dynamics 1363 !! while the fluxes are updated after it. 1364 !! 1365 !! ** Details 1366 !! qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice => provided 1367 !! + qemp_oce + qemp_ice => recalculated and added up to qns 1368 !! 1369 !! qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice => provided 1370 !! 1371 !! emp_tot = emp_oce + emp_ice => calving is provided and added to emp_tot (and emp_oce) 1372 !! river runoff (rnf) is provided but not included here 1364 1373 !! 1365 1374 !! ** Action : update at each nf_ice time step: 1366 1375 !! qns_tot, qsr_tot non-solar and solar total heat fluxes 1367 1376 !! qns_ice, qsr_ice non-solar and solar heat fluxes over the ice 1368 !! emp_tot total evaporation - precipitation(liquid and solid) (-runoff)(-calving)1369 !! emp_ice 1370 !! dqns_ice 1371 !! sprecip 1377 !! emp_tot total evaporation - precipitation(liquid and solid) (-calving) 1378 !! emp_ice ice sublimation - solid precipitation over the ice 1379 !! dqns_ice d(non-solar heat flux)/d(Temperature) over the ice 1380 !! sprecip solid precipitation over the ocean 1372 1381 !!---------------------------------------------------------------------- 1373 1382 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! lead fraction [0 to 1] … … 1379 1388 INTEGER :: jl ! dummy loop index 1380 1389 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, ztmp, zicefr, zmsk, zsnw 1381 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap , zevap_ice, zdevap_ice1390 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 1382 1391 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1383 1392 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice … … 1387 1396 ! 1388 1397 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1389 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap , zevap_ice, zdevap_ice )1398 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1390 1399 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1391 1400 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) … … 1396 1405 ! 1397 1406 ! ! ========================= ! 1398 ! ! freshwater budget ! (emp )1407 ! ! freshwater budget ! (emp_tot) 1399 1408 ! ! ========================= ! 1400 1409 ! 1401 ! ! total Precipitation - total Evaporation (emp_tot)1402 ! ! solid precipitation - sublimation (emp_ice)1403 ! ! solid Precipitation (sprecip)1404 ! ! liquid + solid Precipitation (tprecip)1410 ! ! solid Precipitation (sprecip) 1411 ! ! liquid + solid Precipitation (tprecip) 1412 ! ! total Evaporation - total Precipitation (emp_tot) 1413 ! ! sublimation - solid precipitation (cell average) (emp_ice) 1405 1414 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 1406 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1407 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1408 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1409 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1410 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1411 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1415 CASE( 'conservative' ) ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp 1416 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1417 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1418 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1419 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:) 1420 IF( iom_use('precip') ) & 1421 & CALL iom_put( 'precip' , frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) ) ! total precipitation 1422 IF( iom_use('rain') ) & 1423 & CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1412 1424 IF( iom_use('hflx_rain_cea') ) & 1413 CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1414 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) & 1415 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1425 & CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1416 1426 IF( iom_use('evap_ao_cea' ) ) & 1417 CALL iom_put( 'evap_ao_cea' , ztmp )! ice-free oce evap (cell average)1427 & CALL iom_put( 'evap_ao_cea' , frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! ice-free oce evap (cell average) 1418 1428 IF( iom_use('hflx_evap_cea') ) & 1419 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) )! heat flux from from evap (cell average)1420 CASE( 'oce and ice' 1429 & CALL iom_put( 'hflx_evap_cea', ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * zcptn(:,:) ) ! heat flux from from evap (cell average) 1430 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1421 1431 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1422 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) 1432 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:) 1423 1433 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1424 1434 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) … … 1426 1436 1427 1437 #if defined key_lim3 1428 ! zsnw = snow percentage over ice after wind blowing 1429 zsnw(:,:) = 0._wp 1430 CALL lim_thd_snwblow( p_frld, zsnw ) 1438 ! zsnw = snow fraction over ice after wind blowing 1439 zsnw(:,:) = 0._wp ; CALL lim_thd_snwblow( p_frld, zsnw ) 1431 1440 1432 ! --- evaporation (kg/m2/s) --- ! 1441 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 1442 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip 1443 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) ! emp_oce = emp_tot - emp_ice 1444 1445 ! --- evaporation over ocean (used later for qemp) --- ! 1446 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1447 1448 ! --- evaporation over ice (kg/m2/s) --- ! 1433 1449 zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) 1434 1450 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 … … 1436 1452 zdevap_ice(:,:) = 0._wp 1437 1453 1438 ! --- evaporation minus precipitation corrected for the effect of wind blowing on snow --- ! 1439 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) - zsprecip * (1._wp - zsnw) 1440 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip * (1._wp - zsnw) 1441 1442 ! Sublimation over sea-ice (cell average) 1443 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) 1444 ! runoffs and calving (put in emp_tot) 1454 ! --- runoffs (included in emp later on) --- ! 1445 1455 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1456 1457 ! --- calving (put in emp_tot and emp_oce) --- ! 1446 1458 IF( srcv(jpr_cal)%laction ) THEN 1447 1459 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1460 zemp_oce(:,:) = zemp_oce(:,:) - frcv(jpr_cal)%z3(:,:,1) 1448 1461 CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 1449 1462 ENDIF … … 1471 1484 ENDIF 1472 1485 1473 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1474 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw ) ) ! Snow over ice-free ocean (cell average) 1475 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zsnw ) ! Snow over sea-ice (cell average) 1486 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1487 CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1488 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1489 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1476 1490 #else 1477 ! Sublimation over sea-ice (cell average)1478 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )1479 1491 ! runoffs and calving (put in emp_tot) 1480 1492 IF( srcv(jpr_rnf)%laction ) rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) … … 1496 1508 ENDIF 1497 1509 1498 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1499 IF( iom_use('snow_ao_cea') ) & 1500 CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1501 IF( iom_use('snow_ai_cea') ) & 1502 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1510 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1511 CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1512 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1513 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1503 1514 #endif 1504 1515 … … 1506 1517 SELECT CASE( TRIM( sn_rcv_qns%cldes ) ) ! non solar heat fluxes ! (qns) 1507 1518 ! ! ========================= ! 1508 CASE( 'oce only' ) 1509 zqns_tot(:,: 1510 CASE( 'conservative' ) 1511 zqns_tot(:,: 1519 CASE( 'oce only' ) ! the required field is directly provided 1520 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1521 CASE( 'conservative' ) ! the required fields are directly provided 1522 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 1512 1523 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1513 1524 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1514 1525 ELSE 1515 ! Set all category values equal for the moment1516 1526 DO jl=1,jpl 1517 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1527 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal 1518 1528 ENDDO 1519 1529 ENDIF 1520 CASE( 'oce and ice' ) 1521 zqns_tot(:,: 1530 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1531 zqns_tot(:,:) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1522 1532 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1523 1533 DO jl=1,jpl … … 1526 1536 ENDDO 1527 1537 ELSE 1528 qns_tot(:,: 1538 qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1529 1539 DO jl=1,jpl 1530 1540 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) … … 1532 1542 ENDDO 1533 1543 ENDIF 1534 CASE( 'mixed oce-ice' ) 1544 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations 1535 1545 ! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED ** 1536 1546 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1537 1547 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1538 1548 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) & 1539 & + pist(:,:,1)* zicefr(:,:) ) )1549 & + pist(:,:,1) * zicefr(:,:) ) ) 1540 1550 END SELECT 1541 1551 !!gm … … 1547 1557 !! similar job should be done for snow and precipitation temperature 1548 1558 ! 1549 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1550 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1551 zqns_tot(:,:) = zqns_tot(:,:) - ztmp(:,:) 1552 IF( iom_use('hflx_cal_cea') ) & 1553 CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1554 ENDIF 1555 1556 ztmp(:,:) = p_frld(:,:) * zsprecip(:,:) * lfus 1557 IF( iom_use('hflx_snow_cea') ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1559 IF( srcv(jpr_cal)%laction ) THEN ! Iceberg melting 1560 zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1561 ! we suppose it melts at 0deg, though it should be temp. of surrounding ocean 1562 IF( iom_use('hflx_cal_cea') ) CALL iom_put( 'hflx_cal_cea', - frcv(jpr_cal)%z3(:,:,1) * lfus ) ! heat flux from calving 1563 ENDIF 1558 1564 1559 1565 #if defined key_lim3 1560 ! --- evaporation --- !1561 zevap(:,:) = zemp_tot(:,:) + ztprecip(:,:) ! evaporation over ocean1562 1563 1566 ! --- non solar flux over ocean --- ! 1564 1567 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax … … 1567 1570 1568 1571 ! --- heat flux associated with emp (W/m2) --- ! 1569 zqemp_oce(:,:) = - zevap(:,:) * p_frld(:,:) * zcptn(:,:) &! evap1570 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip1571 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean1572 zqemp_oce(:,:) = - zevap_oce(:,:) * zcptn(:,:) & ! evap 1573 & + ( ztprecip(:,:) - zsprecip(:,:) ) * zcptn(:,:) & ! liquid precip 1574 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus ) ! solid precip over ocean + snow melting 1572 1575 ! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptn(:,:) & ! ice evap 1573 1576 ! & + zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice 1574 1577 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptn(:,:) - lfus ) ! solid precip over ice (only) 1575 ! qevap_ice=0 since we consider Tice=0 °C1578 ! qevap_ice=0 since we consider Tice=0degC 1576 1579 1577 ! --- heat content ofprecip over ice in J/m3 (to be used in 1D-thermo) --- !1580 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 1578 1581 zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 1579 1582 1580 1583 ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 1581 1584 DO jl = 1, jpl 1582 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0 °C1585 zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0degC 1583 1586 END DO 1584 1587 … … 1606 1609 qemp_ice (:,: ) = zqemp_ice (:,: ) 1607 1610 ENDIF 1611 1612 ! some more outputs 1613 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea', sprecip(:,:) * ( zcptn(:,:) - Lfus ) ) ! heat flux from snow (cell average) 1614 IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * zcptn(:,:) ) ! heat flux from rain (cell average) 1615 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea',sprecip(:,:) * ( zcptn(:,:) - Lfus ) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (cell average) 1616 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea',sprecip(:,:) * ( zcptn(:,:) - Lfus ) * zsnw(:,:) ) ! heat flux from snow (cell average) 1617 1608 1618 #else 1609 1619 ! clem: this formulation is certainly wrong... but better than it was... … … 1611 1621 & - ztmp(:,:) & ! remove the latent heat flux of solid precip. melting 1612 1622 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1613 & - zemp_ice(:,:) * zicefr(:,:)) * zcptn(:,:)1623 & - zemp_ice(:,:) ) * zcptn(:,:) 1614 1624 1615 1625 IF( ln_mixcpl ) THEN … … 1731 1741 1732 1742 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) 1733 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap , zevap_ice, zdevap_ice )1743 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1734 1744 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1735 1745 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r6399 r7483 229 229 CALL lim_sbc_flx( kt ) ! Update surface ocean mass, heat and salt fluxes 230 230 ! 231 IF(ln_limdiaout) CALL lim_diahsb 231 IF(ln_limdiaout) CALL lim_diahsb( kt ) ! Diagnostics and outputs 232 232 ! 233 233 CALL lim_wri( 1 ) ! Ice outputs … … 310 310 numit = nit000 - 1 311 311 ENDIF 312 CALL lim_var_agg( 1)312 CALL lim_var_agg(2) 313 313 CALL lim_var_glo2eqv 314 314 ! 315 315 CALL lim_sbc_init ! ice surface boundary condition 316 ! 317 IF( ln_limdiaout) CALL lim_diahsb_init ! initialization for diags 316 318 ! 317 319 fr_i(:,:) = at_i(:,:) ! initialisation of sea-ice fraction -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r6204 r7483 173 173 DO jj = 2, jpjm1 174 174 DO ji = fs_2, fs_jpim1 ! vector opt. 175 zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )176 175 ! total intermediate advective trends 177 ztra = - zbtr *( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &178 & 179 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1))176 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 177 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 178 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) / e1e2t(ji,jj) 180 179 ! update and guess with monotonic sheme 181 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra* tmask(ji,jj,jk)182 zwi(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ztra) * tmask(ji,jj,jk)180 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra / fse3t_n(ji,jj,jk) * tmask(ji,jj,jk) 181 zwi(ji,jj,jk) = ( fse3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + z2dtt * ztra ) / fse3t_a(ji,jj,jk) * tmask(ji,jj,jk) 183 182 END DO 184 183 END DO … … 410 409 DO jj = 2, jpjm1 411 410 DO ji = fs_2, fs_jpim1 ! vector opt. 412 zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )413 411 ! total intermediate advective trends 414 ztra = - zbtr *( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &415 & 416 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1))412 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 413 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 414 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) / e1e2t(ji,jj) 417 415 ! update and guess with monotonic sheme 418 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra419 zwi(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ztra) * tmask(ji,jj,jk)416 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra / fse3t_n(ji,jj,jk) * tmask(ji,jj,jk) 417 zwi(ji,jj,jk) = ( fse3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + z2dtt * ztra ) / fse3t_a(ji,jj,jk) * tmask(ji,jj,jk) 420 418 END DO 421 419 END DO … … 438 436 ! -------------------------------------------------- 439 437 ! antidiffusive flux on i and j 440 441 442 DO jk = 1, jpkm1 443 438 ! 439 DO jk = 1, jpkm1 440 ! 444 441 DO jj = 1, jpjm1 445 442 DO ji = 1, fs_jpim1 ! vector opt. … … 472 469 ! 473 470 ztrs(:,:,:,1) = ptb(:,:,:,jn) 471 ztrs(:,:,1,2) = ptb(:,:,1,jn) 472 ztrs(:,:,1,3) = ptb(:,:,1,jn) 474 473 zwzts(:,:,:) = 0._wp 475 474 … … 572 571 END SUBROUTINE tra_adv_tvd_zts 573 572 573 574 574 SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt ) 575 575 !!--------------------------------------------------------------------- -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r6471 r7483 158 158 ELSE ! No restart or restart not found: Euler forward time stepping 159 159 zfact = 1._wp 160 sbc_tsc(:,:,:) = 0._wp 160 161 sbc_tsc_b(:,:,:) = 0._wp 161 162 ENDIF -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r4624 r7483 162 162 & + avmv(ji,jj,jk) + avmv(ji,jj-1,jk) ) & 163 163 & + avtb(jk) * tmask(ji,jj,jk) 164 ! ! Add the background coefficient on eddy viscosity 164 END DO 165 END DO 166 DO jj = 2, jpjm1 ! Add the background coefficient on eddy viscosity 167 DO ji = 2, jpim1 165 168 avmu(ji,jj,jk) = avmu(ji,jj,jk) + avmb(jk) * umask(ji,jj,jk) 166 169 avmv(ji,jj,jk) = avmv(ji,jj,jk) + avmb(jk) * vmask(ji,jj,jk) -
branches/CNRS/dev_r6526_PISCES_GAS/NEMOGCM/NEMO/OPA_SRC/step.F90
r6405 r7483 337 337 IF( lk_vvl ) CALL dom_vvl_sf_swp( kstp ) ! swap of vertical scale factors 338 338 ! 339 IF( ln_diahsb ) CALL dia_hsb( kstp ) ! - ML - global conservation diagnostics 340 339 341 IF( lrst_oce ) CALL rst_write( kstp ) ! write output ocean restart file 340 342 IF( ln_sto_eos ) CALL sto_rst_write( kstp ) ! write restart file for stochastic parameters … … 351 353 ENDIF 352 354 #endif 353 IF( ln_diahsb ) CALL dia_hsb( kstp ) ! - ML - global conservation diagnostics 354 IF( lk_diaobs ) CALL dia_obs( kstp ) ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 355 IF( lk_diaobs ) CALL dia_obs( kstp ) ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 355 356 356 357 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Note: See TracChangeset
for help on using the changeset viewer.
