Changeset 14072 for NEMO/trunk/tests/STATION_ASF/MY_SRC/sbcssm.F90
- Timestamp:
- 2020-12-04T08:48:38+01:00 (3 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/tests/STATION_ASF/MY_SRC/sbcssm.F90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/tests/STATION_ASF/MY_SRC/sbcssm.F90
r12629 r14072 19 19 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 20 20 ! 21 #if defined key_si3 22 USE ice !#LB: we need to fill the "tm_su" array! 23 USE sbc_ice !#LB: we need to fill the "alb_ice" array! 24 #endif 25 ! 21 26 USE in_out_manager ! I/O manager 22 27 USE iom ! I/O library … … 48 53 INTEGER :: jf_e3t ! index of first T level thickness 49 54 INTEGER :: jf_frq ! index of fraction of qsr absorbed in the 1st T level 55 #if defined key_si3 56 INTEGER :: jf_ifr ! index of sea-ice concentration !#LB 57 INTEGER :: jf_tic ! index of sea-ice surface temperature !#LB 58 INTEGER :: jf_ial ! index of sea-ice surface albedo !#LB 59 #endif 50 60 51 61 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_3d ! structure of input fields (file information, fields read) … … 54 64 !!---------------------------------------------------------------------- 55 65 !! NEMO/SAS 4.0 , NEMO Consortium (2018) 56 !! $Id: sbcssm.F90 1 2615 2020-03-26 15:18:49Z laurent$66 !! $Id: sbcssm.F90 13286 2020-07-09 15:48:29Z smasson $ 57 67 !! Software governed by the CeCILL license (see ./LICENSE) 58 68 !!---------------------------------------------------------------------- … … 73 83 ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 74 84 ! 75 INTEGER :: ji, jj 85 INTEGER :: ji, jj, jl ! dummy loop indices 76 86 REAL(wp) :: ztinta ! ratio applied to after records when doing time interpolation 77 87 REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation … … 84 94 IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d ) !== read data at kt time step ==! 85 95 ! 86 IF( ln_3d_uve ) THEN 87 IF( .NOT. ln_linssh ) THEN 88 e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 89 ELSE 90 e3t_m(:,:) = e3t_0(:,:,1) ! vertical scale factor 91 ENDIF 92 ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 93 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 94 ELSE 95 IF( .NOT. ln_linssh ) THEN 96 e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 97 ELSE 98 e3t_m(:,:) = e3t_0(:,:,1) ! vertical scale factor 99 ENDIF 100 ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 101 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 102 ENDIF 103 ! 96 e3t_m(:,:) = e3t_0(:,:,1) ! vertical scale factor 97 ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 98 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 99 ! 100 !#LB: 101 #if defined key_si3 102 !IF(lwp) WRITE(numout,*) 'LOLO: sbc_ssm()@sbcssm.F90 => fill "tm_su" and other fields at kt =', kt 103 !IF(lwp) WRITE(numout,*) 'LOLO: sbc_ssm()@sbcssm.F90 => shape of at_i ==>', SIZE(at_i,1), SIZE(at_i,2) 104 at_i (:,:) = sf_ssm_2d(jf_ifr)%fnow(:,:,1) * tmask(:,:,1) ! sea-ice concentration [fraction] 105 tm_su(:,:) = sf_ssm_2d(jf_tic)%fnow(:,:,1) * tmask(:,:,1) ! sea-ice surface temperature, read in [K] !#LB 106 sst_m(:,:) = sf_ssm_2d(jf_ial)%fnow(:,:,1) * tmask(:,:,1) ! !!!sst_m AS TEMPORARY ARRAY !!! sea-ice albedo [fraction] 107 DO jl = 1, jpl 108 !IF(lwp) WRITE(numout,*) 'LOLO: sbc_ssm()@sbcssm.F90 => fill "t_su" for ice cat =', jl 109 a_i (:,:,jl) = at_i (:,:) 110 a_i_b (:,:,jl) = at_i (:,:) 111 t_su (:,:,jl) = tm_su(:,:) 112 alb_ice(:,:,jl) = sst_m(:,:) 113 END DO 114 !IF(lwp) WRITE(numout,*) '' 115 #endif 116 !#LB. 104 117 sst_m(:,:) = sf_ssm_2d(jf_tem)%fnow(:,:,1) * tmask(:,:,1) ! temperature 105 118 sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1) ! salinity 106 119 ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height 107 IF( ln_read_frq ) THEN 108 frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1) ! solar penetration 109 ELSE 110 frq_m(:,:) = 1._wp 111 ENDIF 120 frq_m(:,:) = 1._wp 112 121 ELSE 113 122 sss_m(:,:) = 35._wp ! =35. to obtain a physical value for the freezing point … … 116 125 ssv_m(:,:) = 0._wp 117 126 ssh_m(:,:) = 0._wp 118 IF( .NOT. ln_linssh ) e3t_m(:,:) = e3t_0(:,:,1) !clem: necessary at least for sas2D119 127 frq_m(:,:) = 1._wp ! - - 120 128 ssh (:,:,Kmm) = 0._wp ! - - … … 136 144 CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m - : ', mask1=vmask ) 137 145 CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m - : ', mask1=tmask ) 138 IF( .NOT.ln_linssh ) CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m - : ', mask1=tmask )139 IF( ln_read_frq ) CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m - : ', mask1=tmask )140 146 ENDIF 141 147 ! … … 146 152 CALL iom_put( 'sss_m', sss_m ) 147 153 CALL iom_put( 'ssh_m', ssh_m ) 148 IF( .NOT.ln_linssh ) CALL iom_put( 'e3t_m', e3t_m )149 IF( ln_read_frq ) CALL iom_put( 'frq_m', frq_m )150 154 ENDIF 151 155 ! … … 175 179 TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq 176 180 !! 181 TYPE(FLD_N) :: sn_ifr, sn_tic, sn_ial 182 !! 177 183 NAMELIST/namsbc_sas/ l_sasread, cn_dir, ln_3d_uve, ln_read_frq, & 178 & sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 184 & sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq, & 185 & sn_ifr, sn_tic, sn_ial 179 186 !!---------------------------------------------------------------------- 180 187 ! … … 196 203 WRITE(numout,*) ' Namelist namsbc_sas' 197 204 WRITE(numout,*) ' Initialisation using an input file l_sasread = ', l_sasread 198 WRITE(numout,*) ' Are we supplying a 3D u,v and e3 field ln_3d_uve = ', ln_3d_uve199 WRITE(numout,*) ' Are we reading frq (fraction of qsr absorbed in the 1st T level) ln_read_frq = ', ln_read_frq200 205 ENDIF 201 206 ! … … 218 223 IF( lwp ) WRITE(numout,*) ' ==>>> No freshwater budget adjustment needed with StandAlone Surface scheme' 219 224 nn_fwb = 0 225 ENDIF 226 IF( ln_closea ) THEN 227 IF( lwp ) WRITE(numout,*) ' ==>>> No closed seas adjustment needed with StandAlone Surface scheme' 228 ln_closea = .false. 220 229 ENDIF 221 230 … … 230 239 !! and the rest of the logic should still work 231 240 ! 232 jf_tem = 1 ; jf_ssh = 3 ! default 2D fields index 233 jf_sal = 2 ; jf_frq = 4 ! 234 ! 235 IF( ln_3d_uve ) THEN 236 jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3 ! define 3D fields index 237 nfld_3d = 2 + COUNT( (/.NOT.ln_linssh/) ) ! number of 3D fields to read 238 nfld_2d = 3 + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 239 ELSE 240 jf_usp = 4 ; jf_e3t = 6 ! update 2D fields index 241 jf_vsp = 5 ; jf_frq = 6 + COUNT( (/.NOT.ln_linssh/) ) 242 ! 243 nfld_3d = 0 ! no 3D fields to read 244 nfld_2d = 5 + COUNT( (/.NOT.ln_linssh/) ) + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 245 ENDIF 241 !#LB: 242 jf_tem = 1 243 jf_sal = 2 244 jf_ssh = 3 245 jf_usp = 4 246 jf_vsp = 5 247 ! 248 nfld_3d = 0 249 nfld_2d = 5 250 ! 251 #if defined key_si3 252 jf_ifr = jf_vsp + 1 253 jf_tic = jf_vsp + 2 254 jf_ial = jf_vsp + 3 255 nfld_2d = nfld_2d + 3 256 257 !IF(lwp) WRITE(numout,*) 'LOLO: nfld_2d =', nfld_2d 258 !IF(lwp) WRITE(numout,*) 'LOLO: jf_tem =', jf_tem 259 !IF(lwp) WRITE(numout,*) 'LOLO: jf_sal =', jf_sal 260 !IF(lwp) WRITE(numout,*) 'LOLO: jf_ssh =', jf_ssh 261 !IF(lwp) WRITE(numout,*) 'LOLO: jf_usp =', jf_usp 262 !IF(lwp) WRITE(numout,*) 'LOLO: jf_vsp =', jf_vsp 263 !IF(lwp) WRITE(numout,*) 'LOLO: jf_ifr =', jf_ifr 264 !IF(lwp) WRITE(numout,*) 'LOLO: jf_tic =', jf_tic 265 !IF(lwp) WRITE(numout,*) 'LOLO: jf_ial =', jf_ial 266 !IF(lwp) WRITE(numout,*) '' 267 #endif 268 !#LB. 246 269 ! 247 270 IF( nfld_3d > 0 ) THEN … … 252 275 slf_3d(jf_usp) = sn_usp 253 276 slf_3d(jf_vsp) = sn_vsp 254 IF( .NOT.ln_linssh ) slf_3d(jf_e3t) = sn_e3t255 277 ENDIF 256 278 ! … … 261 283 ENDIF 262 284 slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh 263 IF( ln_read_frq ) slf_2d(jf_frq) = sn_frq 264 IF( .NOT. ln_3d_uve ) THEN 265 slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 266 IF( .NOT.ln_linssh ) slf_2d(jf_e3t) = sn_e3t 267 ENDIF 285 slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 268 286 ENDIF 287 ! 288 #if defined key_si3 289 slf_2d(jf_ifr) = sn_ifr !#LB 290 slf_2d(jf_tic) = sn_tic !#LB 291 slf_2d(jf_ial) = sn_ial !#LB 292 #endif 269 293 ! 270 294 ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false.
Note: See TracChangeset
for help on using the changeset viewer.
