- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/SAS/sbcssm.F90
r10068 r13463 26 26 USE lib_mpp ! distributed memory computing library 27 27 USE prtctl ! print control 28 USE fldread ! read input fields 28 USE fldread ! read input fields 29 29 USE timing ! Timing 30 30 … … 38 38 LOGICAL :: ln_3d_uve ! specify whether input velocity data is 3D 39 39 LOGICAL :: ln_read_frq ! specify whether we must read frq or not 40 40 41 41 LOGICAL :: l_sasread ! Ice intilisation: =T read a file ; =F anaytical initilaistion 42 42 LOGICAL :: l_initdone = .false. … … 62 62 CONTAINS 63 63 64 SUBROUTINE sbc_ssm( kt )64 SUBROUTINE sbc_ssm( kt, Kbb, Kmm ) 65 65 !!---------------------------------------------------------------------- 66 66 !! *** ROUTINE sbc_ssm *** … … 69 69 !! for an off-line simulation using surface processes only 70 70 !! 71 !! ** Method : calculates the position of data 71 !! ** Method : calculates the position of data 72 72 !! - interpolates data if needed 73 73 !!---------------------------------------------------------------------- 74 74 INTEGER, INTENT(in) :: kt ! ocean time-step index 75 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 76 ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 75 77 ! 76 78 INTEGER :: ji, jj ! dummy loop indices … … 80 82 ! 81 83 IF( ln_timing ) CALL timing_start( 'sbc_ssm') 82 84 83 85 IF ( l_sasread ) THEN 84 86 IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d ) !== read data at kt time step ==! 85 87 IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d ) !== read data at kt time step ==! 86 ! 88 ! 87 89 IF( ln_3d_uve ) THEN 88 90 IF( .NOT. ln_linssh ) THEN 89 e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 91 e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 90 92 ELSE 91 93 e3t_m(:,:) = e3t_0(:,:,1) ! vertical scale factor 92 94 ENDIF 93 95 ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 94 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 96 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 95 97 ELSE 96 98 IF( .NOT. ln_linssh ) THEN 97 e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 99 e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 98 100 ELSE 99 101 e3t_m(:,:) = e3t_0(:,:,1) ! vertical scale factor 100 102 ENDIF 101 103 ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 102 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 104 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 103 105 ENDIF 104 106 ! … … 119 121 IF( .NOT. ln_linssh ) e3t_m(:,:) = e3t_0(:,:,1) !clem: necessary at least for sas2D 120 122 frq_m(:,:) = 1._wp ! - - 121 ssh n (:,:) = 0._wp ! - -122 ENDIF 123 123 ssh (:,:,Kmm) = 0._wp ! - - 124 ENDIF 125 124 126 IF ( nn_ice == 1 ) THEN 125 ts n(:,:,1,jp_tem) = sst_m(:,:)126 ts n(:,:,1,jp_sal) = sss_m(:,:)127 ts b(:,:,1,jp_tem) = sst_m(:,:)128 ts b(:,:,1,jp_sal) = sss_m(:,:)129 ENDIF 130 u b (:,:,1) = ssu_m(:,:)131 v b (:,:,1) = ssv_m(:,:)132 133 IF( ln_ctl) THEN! print control127 ts(:,:,1,jp_tem,Kmm) = sst_m(:,:) 128 ts(:,:,1,jp_sal,Kmm) = sss_m(:,:) 129 ts(:,:,1,jp_tem,Kbb) = sst_m(:,:) 130 ts(:,:,1,jp_sal,Kbb) = sss_m(:,:) 131 ENDIF 132 uu (:,:,1,Kbb) = ssu_m(:,:) 133 vv (:,:,1,Kbb) = ssv_m(:,:) 134 135 IF(sn_cfctl%l_prtctl) THEN ! print control 134 136 CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m - : ', mask1=tmask ) 135 137 CALL prt_ctl(tab2d_1=sss_m, clinfo1=' sss_m - : ', mask1=tmask ) … … 156 158 157 159 158 SUBROUTINE sbc_ssm_init 160 SUBROUTINE sbc_ssm_init( Kbb, Kmm ) 159 161 !!---------------------------------------------------------------------- 160 162 !! *** ROUTINE sbc_ssm_init *** 161 163 !! 162 !! ** Purpose : Initialisation of sea surface mean data 163 !!---------------------------------------------------------------------- 164 !! ** Purpose : Initialisation of sea surface mean data 165 !!---------------------------------------------------------------------- 166 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 167 ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 164 168 INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3 ! return error code 165 169 INTEGER :: ifpr ! dummy loop indice … … 186 190 ENDIF 187 191 ! 188 REWIND( numnam_ref ) ! Namelist namsbc_sas in reference namelist : Input fields189 192 READ ( numnam_ref, namsbc_sas, IOSTAT = ios, ERR = 901) 190 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_sas in reference namelist', lwp ) 191 REWIND( numnam_cfg ) ! Namelist namsbc_sas in configuration namelist : Input fields 193 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_sas in reference namelist' ) 192 194 READ ( numnam_cfg, namsbc_sas, IOSTAT = ios, ERR = 902 ) 193 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist' , lwp)195 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist' ) 194 196 IF(lwm) WRITE ( numond, namsbc_sas ) 195 ! 197 ! 196 198 IF(lwp) THEN ! Control print 197 199 WRITE(numout,*) ' Namelist namsbc_sas' 198 WRITE(numout,*) ' Initialisation using an input file l_sasread = ', l_sasread 200 WRITE(numout,*) ' Initialisation using an input file l_sasread = ', l_sasread 199 201 WRITE(numout,*) ' Are we supplying a 3D u,v and e3 field ln_3d_uve = ', ln_3d_uve 200 202 WRITE(numout,*) ' Are we reading frq (fraction of qsr absorbed in the 1st T level) ln_read_frq = ', ln_read_frq … … 224 226 ln_closea = .false. 225 227 ENDIF 226 227 ! 228 229 ! 228 230 IF( l_sasread ) THEN ! store namelist information in an array 229 ! 231 ! 230 232 !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 231 233 !! when we have other 3d arrays that we need to read in … … 273 275 ENDIF 274 276 ! 275 ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false. 277 ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false. 276 278 IF( nfld_3d > 0 ) THEN 277 279 ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr ) ! set sf structure … … 280 282 ENDIF 281 283 DO ifpr = 1, nfld_3d 282 284 ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk) , STAT=ierr0 ) 283 285 IF( slf_3d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 ) 284 286 IF( ierr0 + ierr1 > 0 ) THEN … … 288 290 ! ! fill sf with slf_i and control print 289 291 CALL fld_fill( sf_ssm_3d, slf_3d, cn_dir, 'sbc_ssm_init', '3D Data in file', 'namsbc_ssm' ) 292 sf_ssm_3d(jf_usp)%cltype = 'U' ; sf_ssm_3d(jf_usp)%zsgn = -1._wp 293 sf_ssm_3d(jf_vsp)%cltype = 'V' ; sf_ssm_3d(jf_vsp)%zsgn = -1._wp 290 294 ENDIF 291 295 ! … … 296 300 ENDIF 297 301 DO ifpr = 1, nfld_2d 298 302 ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1) , STAT=ierr0 ) 299 303 IF( slf_2d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2) , STAT=ierr1 ) 300 304 IF( ierr0 + ierr1 > 0 ) THEN … … 304 308 ! 305 309 CALL fld_fill( sf_ssm_2d, slf_2d, cn_dir, 'sbc_ssm_init', '2D Data in file', 'namsbc_ssm' ) 310 IF( .NOT. ln_3d_uve ) THEN 311 sf_ssm_2d(jf_usp)%cltype = 'U' ; sf_ssm_2d(jf_usp)%zsgn = -1._wp 312 sf_ssm_2d(jf_vsp)%cltype = 'V' ; sf_ssm_2d(jf_vsp)%zsgn = -1._wp 313 ENDIF 306 314 ENDIF 307 315 ! … … 311 319 ENDIF 312 320 ! 313 CALL sbc_ssm( nit000 ) ! need to define ss?_m arrays used in iceistate321 CALL sbc_ssm( nit000, Kbb, Kmm ) ! need to define ss?_m arrays used in iceistate 314 322 l_initdone = .TRUE. 315 323 !
Note: See TracChangeset
for help on using the changeset viewer.