- Timestamp:
- 2020-12-02T20:53:00+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests
- Files:
-
- 43 added
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/CANAL/MY_SRC/domvvl.F90
r13458 r14021 282 282 ENDIF 283 283 ! 284 IF(lwxios) THEN285 ! define variables in restart file when writing with XIOS286 CALL iom_set_rstw_var_active('e3t_b')287 CALL iom_set_rstw_var_active('e3t_n')288 ! ! ----------------------- !289 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases !290 ! ! ----------------------- !291 CALL iom_set_rstw_var_active('tilde_e3t_b')292 CALL iom_set_rstw_var_active('tilde_e3t_n')293 END IF294 ! ! -------------!295 IF( ln_vvl_ztilde ) THEN ! z_tilde case !296 ! ! ------------ !297 CALL iom_set_rstw_var_active('hdiv_lf')298 ENDIF299 !300 ENDIF301 !302 284 END SUBROUTINE dom_vvl_zgr 303 285 … … 803 785 IF( ln_rstart ) THEN !* Read the restart file 804 786 CALL rst_read_open ! open the restart file if necessary 805 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) , ldxios = lrxios)787 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) ) 806 788 ! 807 789 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 816 798 ! 817 799 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 818 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lrxios)819 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lrxios)800 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 801 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 820 802 ! needed to restart if land processor not computed 821 803 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' … … 831 813 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 832 814 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 833 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lrxios)815 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 834 816 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 835 817 l_1st_euler = .true. … … 838 820 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 839 821 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 840 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lrxios)822 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 841 823 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 842 824 l_1st_euler = .true. … … 863 845 ! ! ----------------------- ! 864 846 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 865 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) , ldxios = lrxios)866 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) , ldxios = lrxios)847 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 848 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 867 849 ELSE ! one at least array is missing 868 850 tilde_e3t_b(:,:,:) = 0.0_wp … … 873 855 ! ! ------------ ! 874 856 IF( id5 > 0 ) THEN ! required array exists 875 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) , ldxios = lrxios)857 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 876 858 ELSE ! array is missing 877 859 hdiv_lf(:,:,:) = 0.0_wp … … 947 929 ! ! =================== 948 930 IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 949 IF( lwxios ) CALL iom_swap( cwxios_context )950 931 ! ! --------- ! 951 932 ! ! all cases ! 952 933 ! ! --------- ! 953 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lwxios)954 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lwxios)934 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) ) 935 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) ) 955 936 ! ! ----------------------- ! 956 937 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! 957 938 ! ! ----------------------- ! 958 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:) , ldxios = lwxios)959 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:) , ldxios = lwxios)939 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:)) 940 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:)) 960 941 END IF 961 942 ! ! -------------! 962 943 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 963 944 ! ! ------------ ! 964 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) , ldxios = lwxios)945 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:)) 965 946 ENDIF 966 947 ! 967 IF( lwxios ) CALL iom_swap( cxios_context )968 948 ENDIF 969 949 ! -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/CANAL/MY_SRC/trazdf.F90
r13295 r14021 54 54 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 55 55 ! 56 INTEGER :: j k ! Dummy loop indices56 INTEGER :: ji, jj, jk ! Dummy loop indices 57 57 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds ! 3D workspace 58 58 !!--------------------------------------------------------------------- … … 61 61 ! 62 62 IF( kt == nit000 ) THEN 63 IF(lwp)WRITE(numout,*) 64 IF(lwp)WRITE(numout,*) 'tra_zdf : implicit vertical mixing on T & S' 65 IF(lwp)WRITE(numout,*) '~~~~~~~ ' 63 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 64 IF(lwp)WRITE(numout,*) 65 IF(lwp)WRITE(numout,*) 'tra_zdf : implicit vertical mixing on T & S' 66 IF(lwp)WRITE(numout,*) '~~~~~~~ ' 67 ENDIF 66 68 ENDIF 67 69 ! … … 83 85 84 86 IF( l_trdtra ) THEN ! save the vertical diffusive trends for further diagnostics 85 DO jk = 1, jpkm1 86 ztrdt(:,:,jk) = ( ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) - pts(:,:,jk,jp_tem,Kbb)*e3t(:,:,jk,Kbb) ) & 87 & / (e3t(:,:,jk,Kmm)*rDt) ) - ztrdt(:,:,jk) 88 ztrds(:,:,jk) = ( ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) - pts(:,:,jk,jp_sal,Kbb)*e3t(:,:,jk,Kbb) ) & 89 & / (e3t(:,:,jk,Kmm)*rDt) ) - ztrds(:,:,jk) 87 DO jk = 1, jpk 88 ztrdt(:,:,jk) = ( ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) & 89 & - pts(:,:,jk,jp_tem,Kbb)*e3t(:,:,jk,Kbb) ) & 90 & / ( e3t(:,:,jk,Kmm)*rDt ) ) & 91 & - ztrdt(:,:,jk) 92 ztrds(:,:,jk) = ( ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) & 93 & - pts(:,:,jk,jp_sal,Kbb)*e3t(:,:,jk,Kbb) ) & 94 & / ( e3t(:,:,jk,Kmm)*rDt ) ) & 95 & - ztrds(:,:,jk) 90 96 END DO 91 97 !!gm this should be moved in trdtra.F90 and done on all trends … … 135 141 INTEGER :: ji, jj, jk, jn ! dummy loop indices 136 142 REAL(wp) :: zrhs, zzwi, zzws ! local scalars 137 REAL(wp), DIMENSION( jpi,jpj,jpk) :: zwi, zwt, zwd, zws143 REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: zwi, zwt, zwd, zws 138 144 !!--------------------------------------------------------------------- 139 145 ! … … 149 155 ! 150 156 ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers 151 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN ; zwt(:,:,2:jpk) = avt(:,:,2:jpk) 152 ELSE ; zwt(:,:,2:jpk) = avs(:,:,2:jpk) 157 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 158 DO_3D( 1, 1, 1, 1, 2, jpk ) 159 zwt(ji,jj,jk) = avt(ji,jj,jk) 160 END_3D 161 ELSE 162 DO_3D( 1, 1, 1, 1, 2, jpk ) 163 zwt(ji,jj,jk) = avs(ji,jj,jk) 164 END_3D 153 165 ENDIF 154 166 zwt(:,:,1) = 0._wp -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/ICE_ADV2D/MY_SRC/usrdef_sbc.F90
r13472 r14021 18 18 USE sbc_ice ! Surface boundary condition: ice fields 19 19 USE phycst ! physical constants 20 USE ice, ONLY : at_i_b, a_i_b20 USE ice, ONLY : jpl, at_i_b, a_i_b 21 21 USE icethd_dh ! for CALL ice_thd_snwblow 22 22 ! -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/ISOMIP+/MY_SRC/dtatsd.F90
r13583 r14021 18 18 USE phycst ! physical constants 19 19 USE dom_oce ! ocean space and time domain 20 USE domain, ONLY : dom_tile 20 21 USE fldread ! read input fields 21 22 ! … … 163 164 INTEGER , INTENT(in ) :: kt ! ocean time-step 164 165 CHARACTER(LEN=3) , INTENT(in ) :: cddta ! dmp or ini 165 REAL(wp), DIMENSION( jpi,jpj,jpk,jpts), INTENT( out) :: ptsd ! T & S data166 REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts), INTENT( out) :: ptsd ! T & S data 166 167 ! 167 168 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 168 169 INTEGER :: ik, il0, il1, ii0, ii1, ij0, ij1 ! local integers 170 INTEGER :: itile 169 171 REAL(wp):: zl, zi ! local scalars 170 172 REAL(wp), DIMENSION(jpk) :: ztp, zsp ! 1D workspace 171 173 !!---------------------------------------------------------------------- 172 174 ! 175 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only for the full domain 176 itile = ntile 177 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 178 179 SELECT CASE(cddta) 180 CASE('ini') 181 CALL fld_read( kt, 1, sf_tsdini ) !== read T & S data at kt time step ==! 182 CASE('dmp') 183 CALL fld_read( kt, 1, sf_tsddmp ) !== read T & S data at kt time step ==! 184 CASE DEFAULT 185 CALL ctl_stop('STOP', 'dta_tsd: cddta case unknown') 186 END SELECT 187 188 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 189 ENDIF 190 ! 173 191 SELECT CASE(cddta) 174 CASE('ini') 175 CALL fld_read( kt, 1, sf_tsdini ) !== read T & S data at kt time step ==! 176 ptsd(:,:,:,jp_tem) = sf_tsdini(jp_tem)%fnow(:,:,:) ! NO mask 177 ptsd(:,:,:,jp_sal) = sf_tsdini(jp_sal)%fnow(:,:,:) 192 CASE('ini') 193 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 194 ptsd(ji,jj,jk,jp_tem) = sf_tsdini(jp_tem)%fnow(ji,jj,jk) ! NO mask 195 ptsd(ji,jj,jk,jp_sal) = sf_tsdini(jp_sal)%fnow(ji,jj,jk) 196 END_3D 178 197 CASE('dmp') 179 CALL fld_read( kt, 1, sf_tsddmp ) !== read T & S data at kt time step ==! 180 ptsd(:,:,:,jp_tem) = sf_tsddmp(jp_tem)%fnow(:,:,:) ! NO mask 181 ptsd(:,:,:,jp_sal) = sf_tsddmp(jp_sal)%fnow(:,:,:) 198 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 199 ptsd(ji,jj,jk,jp_tem) = sf_tsddmp(jp_tem)%fnow(ji,jj,jk) ! NO mask 200 ptsd(ji,jj,jk,jp_sal) = sf_tsddmp(jp_sal)%fnow(ji,jj,jk) 201 END_3D 182 202 CASE DEFAULT 183 203 CALL ctl_stop('STOP', 'dta_tsd: cddta case unknown') … … 186 206 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 187 207 ! 188 IF( kt == nit000 .AND. lwp )THEN 189 WRITE(numout,*) 190 WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 208 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 209 IF( kt == nit000 .AND. lwp )THEN 210 WRITE(numout,*) 211 WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 212 ENDIF 191 213 ENDIF 192 214 ! … … 220 242 ELSE !== z- or zps- coordinate ==! 221 243 ! 222 ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:) ! Mask 223 ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 244 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 245 ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) ! Mask 246 ptsd(ji,jj,jk,jp_sal) = ptsd(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 247 END_3D 224 248 ! 225 249 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/ISOMIP+/MY_SRC/eosbn2.F90
r13583 r14021 39 39 !!---------------------------------------------------------------------- 40 40 USE dom_oce ! ocean space and time domain 41 USE domutl, ONLY : is_tile 41 42 USE phycst ! physical constants 42 43 USE stopar ! Stochastic T/S fluctuations … … 55 56 ! !! * Interface 56 57 INTERFACE eos 57 MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d 58 MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d, eos_insitu_pot_2d 58 59 END INTERFACE 59 60 ! … … 191 192 192 193 SUBROUTINE eos_insitu( pts, prd, pdep ) 194 !! 195 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 196 ! ! 2 : salinity [psu] 197 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-] 198 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 199 !! 200 CALL eos_insitu_t( pts, is_tile(pts), prd, is_tile(prd), pdep, is_tile(pdep) ) 201 END SUBROUTINE eos_insitu 202 203 SUBROUTINE eos_insitu_t( pts, ktts, prd, ktrd, pdep, ktdep ) 193 204 !!---------------------------------------------------------------------- 194 205 !! *** ROUTINE eos_insitu *** … … 228 239 !! TEOS-10 Manual, 2010 229 240 !!---------------------------------------------------------------------- 230 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 241 INTEGER , INTENT(in ) :: ktts, ktrd, ktdep 242 REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 231 243 ! ! 2 : salinity [psu] 232 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT( out) :: prd ! in situ density [-]233 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in ) :: pdep ! depth [m]244 REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-] 245 REAL(wp), DIMENSION(A2D_T(ktdep),JPK ), INTENT(in ) :: pdep ! depth [m] 234 246 ! 235 247 INTEGER :: ji, jj, jk ! dummy loop indices … … 312 324 IF( ln_timing ) CALL timing_stop('eos-insitu') 313 325 ! 314 END SUBROUTINE eos_insitu 326 END SUBROUTINE eos_insitu_t 315 327 316 328 317 329 SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 330 !! 331 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 332 ! ! 2 : salinity [psu] 333 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-] 334 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prhop ! potential density (surface referenced) 335 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 336 !! 337 CALL eos_insitu_pot_t( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) ) 338 END SUBROUTINE eos_insitu_pot 339 340 341 SUBROUTINE eos_insitu_pot_t( pts, ktts, prd, ktrd, prhop, ktrhop, pdep, ktdep ) 318 342 !!---------------------------------------------------------------------- 319 343 !! *** ROUTINE eos_insitu_pot *** … … 328 352 !! 329 353 !!---------------------------------------------------------------------- 330 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 354 INTEGER , INTENT(in ) :: ktts, ktrd, ktrhop, ktdep 355 REAL(wp), DIMENSION(A2D_T(ktts) ,JPK,JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 331 356 ! ! 2 : salinity [psu] 332 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT( out) :: prd ! in situ density [-]333 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT( out) :: prhop ! potential density (surface referenced)334 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in ) :: pdep ! depth [m]357 REAL(wp), DIMENSION(A2D_T(ktrd) ,JPK ), INTENT( out) :: prd ! in situ density [-] 358 REAL(wp), DIMENSION(A2D_T(ktrhop),JPK ), INTENT( out) :: prhop ! potential density (surface referenced) 359 REAL(wp), DIMENSION(A2D_T(ktdep) ,JPK ), INTENT(in ) :: pdep ! depth [m] 335 360 ! 336 361 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices … … 482 507 IF( ln_timing ) CALL timing_stop('eos-pot') 483 508 ! 484 END SUBROUTINE eos_insitu_pot 509 END SUBROUTINE eos_insitu_pot_t 485 510 486 511 487 512 SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 513 !! 514 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 515 ! ! 2 : salinity [psu] 516 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pdep ! depth [m] 517 REAL(wp), DIMENSION(:,:) , INTENT( out) :: prd ! in situ density 518 !! 519 CALL eos_insitu_2d_t( pts, is_tile(pts), pdep, is_tile(pdep), prd, is_tile(prd) ) 520 END SUBROUTINE eos_insitu_2d 521 522 523 SUBROUTINE eos_insitu_2d_t( pts, ktts, pdep, ktdep, prd, ktrd ) 488 524 !!---------------------------------------------------------------------- 489 525 !! *** ROUTINE eos_insitu_2d *** … … 496 532 !! 497 533 !!---------------------------------------------------------------------- 498 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 534 INTEGER , INTENT(in ) :: ktts, ktdep, ktrd 535 REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 499 536 ! ! 2 : salinity [psu] 500 REAL(wp), DIMENSION( jpi,jpj), INTENT(in ) :: pdep ! depth [m]501 REAL(wp), DIMENSION( jpi,jpj), INTENT( out) :: prd ! in situ density537 REAL(wp), DIMENSION(A2D_T(ktdep) ), INTENT(in ) :: pdep ! depth [m] 538 REAL(wp), DIMENSION(A2D_T(ktrd) ), INTENT( out) :: prd ! in situ density 502 539 ! 503 540 INTEGER :: ji, jj, jk ! dummy loop indices … … 584 621 IF( ln_timing ) CALL timing_stop('eos2d') 585 622 ! 586 END SUBROUTINE eos_insitu_2d 623 END SUBROUTINE eos_insitu_2d_t 624 625 626 SUBROUTINE eos_insitu_pot_2d( pts, prhop ) 627 !!---------------------------------------------------------------------- 628 !! *** ROUTINE eos_insitu_pot *** 629 !! 630 !! ** Purpose : Compute the in situ density (ratio rho/rho0) and the 631 !! potential volumic mass (Kg/m3) from potential temperature and 632 !! salinity fields using an equation of state selected in the 633 !! namelist. 634 !! 635 !! ** Action : 636 !! - prhop, the potential volumic mass (Kg/m3) 637 !! 638 !!---------------------------------------------------------------------- 639 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 640 ! ! 2 : salinity [psu] 641 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out) :: prhop ! potential density (surface referenced) 642 ! 643 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices 644 INTEGER :: jdof 645 REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars 646 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 647 REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors 648 !!---------------------------------------------------------------------- 649 ! 650 IF( ln_timing ) CALL timing_start('eos-pot') 651 ! 652 SELECT CASE ( neos ) 653 ! 654 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 655 ! 656 DO_2D( 1, 1, 1, 1 ) 657 ! 658 zt = pts (ji,jj,jp_tem) * r1_T0 ! temperature 659 zs = SQRT( ABS( pts(ji,jj,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 660 ztm = tmask(ji,jj,1) ! tmask 661 ! 662 zn0 = (((((EOS060*zt & 663 & + EOS150*zs+EOS050)*zt & 664 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 665 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 666 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 667 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 668 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 669 ! 670 ! 671 prhop(ji,jj) = zn0 * ztm ! potential density referenced at the surface 672 ! 673 END_2D 674 675 CASE( np_seos ) !== simplified EOS ==! 676 ! 677 DO_2D( 1, 1, 1, 1 ) 678 zt = pts (ji,jj,jp_tem) - 10._wp 679 zs = pts (ji,jj,jp_sal) - 35._wp 680 ztm = tmask(ji,jj,1) 681 ! ! potential density referenced at the surface 682 zn = - rn_a0 * ( 1._wp + 0.5_wp*rn_lambda1*zt ) * zt & 683 & + rn_b0 * ( 1._wp - 0.5_wp*rn_lambda2*zs ) * zs & 684 & - rn_nu * zt * zs 685 prhop(ji,jj) = ( rho0 + zn ) * ztm 686 ! 687 END_2D 688 ! 689 CASE( np_leos ) !== ISOMIP EOS ==! 690 ! 691 DO_2D( 1, 1, 1, 1 ) 692 ! 693 zt = pts (ji,jj,jp_tem) - (-1._wp) 694 zs = pts (ji,jj,jp_sal) - 34.2_wp 695 !zh = pdep (ji,jj) ! depth at the partial step level 696 ! 697 zn = rho0 * ( - rn_a0 * zt + rn_b0 * zs ) 698 ! 699 prhop(ji,jj) = zn * r1_rho0 ! unmasked in situ density anomaly 700 ! 701 END_2D 702 ! 703 END SELECT 704 ! 705 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=prhop, clinfo1=' eos-pot: ' ) 706 ! 707 IF( ln_timing ) CALL timing_stop('eos-pot') 708 ! 709 END SUBROUTINE eos_insitu_pot_2d 587 710 588 711 589 712 SUBROUTINE rab_3d( pts, pab, Kmm ) 713 !! 714 INTEGER , INTENT(in ) :: Kmm ! time level index 715 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity 716 REAL(wp), DIMENSION(:,:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio 717 !! 718 CALL rab_3d_t( pts, is_tile(pts), pab, is_tile(pab), Kmm ) 719 END SUBROUTINE rab_3d 720 721 722 SUBROUTINE rab_3d_t( pts, ktts, pab, ktab, Kmm ) 590 723 !!---------------------------------------------------------------------- 591 724 !! *** ROUTINE rab_3d *** … … 598 731 !!---------------------------------------------------------------------- 599 732 INTEGER , INTENT(in ) :: Kmm ! time level index 600 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 601 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab ! thermal/haline expansion ratio 733 INTEGER , INTENT(in ) :: ktts, ktab 734 REAL(wp), DIMENSION(A2D_T(ktts),JPK,JPTS), INTENT(in ) :: pts ! pot. temperature & salinity 735 REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio 602 736 ! 603 737 INTEGER :: ji, jj, jk ! dummy loop indices … … 706 840 IF( ln_timing ) CALL timing_stop('rab_3d') 707 841 ! 708 END SUBROUTINE rab_3d 842 END SUBROUTINE rab_3d_t 709 843 710 844 711 845 SUBROUTINE rab_2d( pts, pdep, pab, Kmm ) 846 !! 847 INTEGER , INTENT(in ) :: Kmm ! time level index 848 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity 849 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pdep ! depth [m] 850 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio 851 !! 852 CALL rab_2d_t(pts, is_tile(pts), pdep, is_tile(pdep), pab, is_tile(pab), Kmm) 853 END SUBROUTINE rab_2d 854 855 856 SUBROUTINE rab_2d_t( pts, ktts, pdep, ktdep, pab, ktab, Kmm ) 712 857 !!---------------------------------------------------------------------- 713 858 !! *** ROUTINE rab_2d *** … … 718 863 !!---------------------------------------------------------------------- 719 864 INTEGER , INTENT(in ) :: Kmm ! time level index 720 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT(in ) :: pts ! pot. temperature & salinity 721 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 722 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT( out) :: pab ! thermal/haline expansion ratio 865 INTEGER , INTENT(in ) :: ktts, ktdep, ktab 866 REAL(wp), DIMENSION(A2D_T(ktts),JPTS), INTENT(in ) :: pts ! pot. temperature & salinity 867 REAL(wp), DIMENSION(A2D_T(ktdep) ), INTENT(in ) :: pdep ! depth [m] 868 REAL(wp), DIMENSION(A2D_T(ktab),JPTS), INTENT( out) :: pab ! thermal/haline expansion ratio 723 869 ! 724 870 INTEGER :: ji, jj, jk ! dummy loop indices … … 829 975 IF( ln_timing ) CALL timing_stop('rab_2d') 830 976 ! 831 END SUBROUTINE rab_2d 977 END SUBROUTINE rab_2d_t 832 978 833 979 … … 942 1088 943 1089 SUBROUTINE bn2( pts, pab, pn2, Kmm ) 1090 !! 1091 INTEGER , INTENT(in ) :: Kmm ! time level index 1092 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 1093 REAL(wp), DIMENSION(:,:,:,:) , INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] 1094 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 1095 !! 1096 CALL bn2_t( pts, pab, is_tile(pab), pn2, is_tile(pn2), Kmm ) 1097 END SUBROUTINE bn2 1098 1099 1100 SUBROUTINE bn2_t( pts, pab, ktab, pn2, ktn2, Kmm ) 944 1101 !!---------------------------------------------------------------------- 945 1102 !! *** ROUTINE bn2 *** … … 956 1113 !!---------------------------------------------------------------------- 957 1114 INTEGER , INTENT(in ) :: Kmm ! time level index 1115 INTEGER , INTENT(in ) :: ktab, ktn2 958 1116 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 959 REAL(wp), DIMENSION( jpi,jpj,jpk,jpts), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1]960 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2]1117 REAL(wp), DIMENSION(A2D_T(ktab),JPK,JPTS), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] 1118 REAL(wp), DIMENSION(A2D_T(ktn2),JPK ), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 961 1119 ! 962 1120 INTEGER :: ji, jj, jk ! dummy loop indices … … 982 1140 IF( ln_timing ) CALL timing_stop('bn2') 983 1141 ! 984 END SUBROUTINE bn2 1142 END SUBROUTINE bn2_t 985 1143 986 1144 … … 1043 1201 1044 1202 SUBROUTINE eos_fzp_2d( psal, ptf, pdep ) 1203 !! 1204 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 1205 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m] 1206 REAL(wp), DIMENSION(:,:) , INTENT(out ) :: ptf ! freezing temperature [Celsius] 1207 !! 1208 CALL eos_fzp_2d_t( psal, ptf, is_tile(ptf), pdep ) 1209 END SUBROUTINE eos_fzp_2d 1210 1211 1212 SUBROUTINE eos_fzp_2d_t( psal, ptf, kttf, pdep ) 1045 1213 !!---------------------------------------------------------------------- 1046 1214 !! *** ROUTINE eos_fzp *** … … 1054 1222 !! Reference : UNESCO tech. papers in the marine science no. 28. 1978 1055 1223 !!---------------------------------------------------------------------- 1224 INTEGER , INTENT(in ) :: kttf 1056 1225 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 1057 1226 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m] 1058 REAL(wp), DIMENSION( jpi,jpj), INTENT(out ) :: ptf ! freezing temperature [Celsius]1227 REAL(wp), DIMENSION(A2D_T(kttf)), INTENT(out ) :: ptf ! freezing temperature [Celsius] 1059 1228 ! 1060 1229 INTEGER :: ji, jj ! dummy loop indices … … 1089 1258 END SELECT 1090 1259 ! 1091 END SUBROUTINE eos_fzp_2d 1260 END SUBROUTINE eos_fzp_2d_t 1092 1261 1093 1262 -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/ISOMIP+/MY_SRC/tradmp.F90
r13295 r14021 95 95 ! 96 96 INTEGER :: ji, jj, jk, jn ! dummy loop indices 97 REAL(wp), DIMENSION( jpi,jpj,jpk,jpts) :: zts_dta97 REAL(wp), DIMENSION(A2D(nn_hls),jpk,jpts) :: zts_dta 98 98 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: ztrdts 99 99 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/STATION_ASF/MY_SRC/nemogcm.F90
r13655 r14021 271 271 IF( ln_timing ) CALL timing_start( 'nemo_init') 272 272 ! 273 CALL phy_cst ! Physical constants274 CALL eos_init ! Equation of state273 CALL phy_cst ! Physical constants 274 CALL eos_init ! Equation of state 275 275 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 276 CALL dom_init( Nbb, Nnn, Naa, "OPA") ! Domain276 CALL dom_init( Nbb, Nnn, Naa ) ! Domain 277 277 IF( sn_cfctl%l_prtctl ) & 278 278 & CALL prt_ctl_init ! Print control 279 279 280 CALL istate_init( Nbb, Nnn, Naa ) ! ocean initial state (Dynamics and tracers)280 CALL istate_init( Nbb, Nnn, Naa ) ! ocean initial state (Dynamics and tracers) 281 281 282 282 ! ! external forcing 283 CALL sbc_init( Nbb, Nnn, Naa ) ! surface boundary conditions (including sea-ice)283 CALL sbc_init( Nbb, Nnn, Naa ) ! surface boundary conditions (including sea-ice) 284 284 285 285 !#LB: -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/VORTEX/MY_SRC/domvvl.F90
r13458 r14021 282 282 ENDIF 283 283 ! 284 IF(lwxios) THEN285 ! define variables in restart file when writing with XIOS286 CALL iom_set_rstw_var_active('e3t_b')287 CALL iom_set_rstw_var_active('e3t_n')288 ! ! ----------------------- !289 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases !290 ! ! ----------------------- !291 CALL iom_set_rstw_var_active('tilde_e3t_b')292 CALL iom_set_rstw_var_active('tilde_e3t_n')293 END IF294 ! ! -------------!295 IF( ln_vvl_ztilde ) THEN ! z_tilde case !296 ! ! ------------ !297 CALL iom_set_rstw_var_active('hdiv_lf')298 ENDIF299 !300 ENDIF301 !302 284 END SUBROUTINE dom_vvl_zgr 303 285 … … 803 785 IF( ln_rstart ) THEN !* Read the restart file 804 786 CALL rst_read_open ! open the restart file if necessary 805 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) , ldxios = lrxios)787 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm) ) 806 788 ! 807 789 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 816 798 ! 817 799 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 818 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lrxios)819 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lrxios)800 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 801 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 820 802 ! needed to restart if land processor not computed 821 803 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' … … 831 813 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 832 814 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 833 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lrxios)815 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 834 816 e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 835 817 l_1st_euler = .true. … … 838 820 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 839 821 IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 840 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lrxios)822 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 841 823 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 842 824 l_1st_euler = .true. … … 863 845 ! ! ----------------------- ! 864 846 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 865 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) , ldxios = lrxios)866 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) , ldxios = lrxios)847 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 848 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 867 849 ELSE ! one at least array is missing 868 850 tilde_e3t_b(:,:,:) = 0.0_wp … … 873 855 ! ! ------------ ! 874 856 IF( id5 > 0 ) THEN ! required array exists 875 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) , ldxios = lrxios)857 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 876 858 ELSE ! array is missing 877 859 hdiv_lf(:,:,:) = 0.0_wp … … 947 929 ! ! =================== 948 930 IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 949 IF( lwxios ) CALL iom_swap( cwxios_context )950 931 ! ! --------- ! 951 932 ! ! all cases ! 952 933 ! ! --------- ! 953 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) , ldxios = lwxios)954 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) , ldxios = lwxios)934 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) ) 935 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) ) 955 936 ! ! ----------------------- ! 956 937 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! 957 938 ! ! ----------------------- ! 958 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:) , ldxios = lwxios)959 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:) , ldxios = lwxios)939 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:)) 940 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:)) 960 941 END IF 961 942 ! ! -------------! 962 943 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 963 944 ! ! ------------ ! 964 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) , ldxios = lwxios)945 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:)) 965 946 ENDIF 966 947 ! 967 IF( lwxios ) CALL iom_swap( cxios_context )968 948 ENDIF 969 949 ! -
NEMO/branches/2020/dev_r13648_ASINTER-04_laurent_bulk_ice/tests/demo_cfgs.txt
r13675 r14021 12 12 STATION_ASF OCE ICE 13 13 CPL_OASIS OCE TOP ICE NST 14 C1D_ASICS OCE 15 ICE_RHEO OCE SAS ICE
Note: See TracChangeset
for help on using the changeset viewer.