- Timestamp:
- 2019-12-13T19:48:00+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/tests/STATION_ASF/MY_SRC/sbcssm.F90
r11831 r12249 14 14 USE c1d ! 1D configuration: lk_c1d 15 15 USE dom_oce ! ocean domain: variables 16 !LB:USE zdf_oce ! ocean vertical physics: variables17 16 USE sbc_oce ! surface module: variables 18 17 USE phycst ! physical constants 19 18 USE eosbn2 ! equation of state - Brunt Vaisala frequency 20 19 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 21 !LB:USE zpshde ! z-coord. with partial steps: horizontal derivatives22 !LB:USE closea ! for ln_closea23 20 ! 24 21 USE in_out_manager ! I/O manager … … 26 23 USE lib_mpp ! distributed memory computing library 27 24 USE prtctl ! print control 28 USE fldread ! read input fields 25 USE fldread ! read input fields 29 26 USE timing ! Timing 30 27 … … 32 29 PRIVATE 33 30 34 PUBLIC sbc_ssm ! routine called by step.F9035 PUBLIC sbc_ssm _init ! routine called by sbcmod.F9031 PUBLIC sbc_ssm_init ! called by sbc_init 32 PUBLIC sbc_ssm ! called by sbc 36 33 37 34 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssm files 38 35 LOGICAL :: ln_3d_uve ! specify whether input velocity data is 3D 39 36 LOGICAL :: ln_read_frq ! specify whether we must read frq or not 40 37 41 38 LOGICAL :: l_sasread ! Ice intilisation: =T read a file ; =F anaytical initilaistion 42 39 LOGICAL :: l_initdone = .false. … … 62 59 CONTAINS 63 60 64 SUBROUTINE sbc_ssm( kt )61 SUBROUTINE sbc_ssm( kt, Kbb, Kmm ) 65 62 !!---------------------------------------------------------------------- 66 63 !! *** ROUTINE sbc_ssm *** … … 69 66 !! for an off-line simulation using surface processes only 70 67 !! 71 !! ** Method : calculates the position of data 68 !! ** Method : calculates the position of data 72 69 !! - interpolates data if needed 73 70 !!---------------------------------------------------------------------- 74 71 INTEGER, INTENT(in) :: kt ! ocean time-step index 72 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 73 ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 75 74 ! 76 75 INTEGER :: ji, jj ! dummy loop indices … … 80 79 ! 81 80 IF( ln_timing ) CALL timing_start( 'sbc_ssm') 82 81 83 82 IF ( l_sasread ) THEN 84 83 IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d ) !== read data at kt time step ==! 85 84 IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d ) !== read data at kt time step ==! 86 ! 85 ! 87 86 IF( ln_3d_uve ) THEN 88 87 IF( .NOT. ln_linssh ) THEN 89 e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 88 e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 90 89 ELSE 91 90 e3t_m(:,:) = e3t_0(:,:,1) ! vertical scale factor 92 91 ENDIF 93 92 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 93 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 95 94 ELSE 96 95 IF( .NOT. ln_linssh ) THEN 97 e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 96 e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! vertical scale factor 98 97 ELSE 99 98 e3t_m(:,:) = e3t_0(:,:,1) ! vertical scale factor 100 99 ENDIF 101 100 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 101 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 103 102 ENDIF 104 103 ! … … 119 118 IF( .NOT. ln_linssh ) e3t_m(:,:) = e3t_0(:,:,1) !clem: necessary at least for sas2D 120 119 frq_m(:,:) = 1._wp ! - - 121 ssh n (:,:) = 0._wp ! - -122 ENDIF 123 120 ssh (:,:,Kmm) = 0._wp ! - - 121 ENDIF 122 124 123 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 control124 ts(:,:,1,jp_tem,Kmm) = sst_m(:,:) 125 ts(:,:,1,jp_sal,Kmm) = sss_m(:,:) 126 ts(:,:,1,jp_tem,Kbb) = sst_m(:,:) 127 ts(:,:,1,jp_sal,Kbb) = sss_m(:,:) 128 ENDIF 129 uu (:,:,1,Kbb) = ssu_m(:,:) 130 vv (:,:,1,Kbb) = ssv_m(:,:) 131 132 IF(sn_cfctl%l_prtctl) THEN ! print control 134 133 CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m - : ', mask1=tmask ) 135 134 CALL prt_ctl(tab2d_1=sss_m, clinfo1=' sss_m - : ', mask1=tmask ) … … 156 155 157 156 158 SUBROUTINE sbc_ssm_init 157 SUBROUTINE sbc_ssm_init( Kbb, Kmm ) 159 158 !!---------------------------------------------------------------------- 160 159 !! *** ROUTINE sbc_ssm_init *** 161 160 !! 162 !! ** Purpose : Initialisation of sea surface mean data 163 !!---------------------------------------------------------------------- 161 !! ** Purpose : Initialisation of sea surface mean data 162 !!---------------------------------------------------------------------- 163 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 164 ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 164 165 INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3 ! return error code 165 166 INTEGER :: ifpr ! dummy loop indice … … 186 187 ENDIF 187 188 ! 188 REWIND( numnam_ref ) ! Namelist namsbc_sas in reference namelist : Input fields189 189 READ ( numnam_ref, namsbc_sas, IOSTAT = ios, ERR = 901) 190 190 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_sas in reference namelist' ) 191 REWIND( numnam_cfg ) ! Namelist namsbc_sas in configuration namelist : Input fields192 191 READ ( numnam_cfg, namsbc_sas, IOSTAT = ios, ERR = 902 ) 193 192 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist' ) 194 193 IF(lwm) WRITE ( numond, namsbc_sas ) 195 ! 194 ! 196 195 IF(lwp) THEN ! Control print 197 196 WRITE(numout,*) ' Namelist namsbc_sas' 198 WRITE(numout,*) ' Initialisation using an input file l_sasread = ', l_sasread 197 WRITE(numout,*) ' Initialisation using an input file l_sasread = ', l_sasread 199 198 WRITE(numout,*) ' Are we supplying a 3D u,v and e3 field ln_3d_uve = ', ln_3d_uve 200 199 WRITE(numout,*) ' Are we reading frq (fraction of qsr absorbed in the 1st T level) ln_read_frq = ', ln_read_frq … … 220 219 nn_fwb = 0 221 220 ENDIF 222 223 ! 221 222 ! 224 223 IF( l_sasread ) THEN ! store namelist information in an array 225 ! 224 ! 226 225 !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 227 226 !! when we have other 3d arrays that we need to read in … … 269 268 ENDIF 270 269 ! 271 ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false. 270 ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false. 272 271 IF( nfld_3d > 0 ) THEN 273 272 ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr ) ! set sf structure … … 276 275 ENDIF 277 276 DO ifpr = 1, nfld_3d 278 277 ALLOCATE( sf_ssm_3d(ifpr)%fnow(jpi,jpj,jpk) , STAT=ierr0 ) 279 278 IF( slf_3d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_3d(ifpr)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 ) 280 279 IF( ierr0 + ierr1 > 0 ) THEN … … 292 291 ENDIF 293 292 DO ifpr = 1, nfld_2d 294 293 ALLOCATE( sf_ssm_2d(ifpr)%fnow(jpi,jpj,1) , STAT=ierr0 ) 295 294 IF( slf_2d(ifpr)%ln_tint ) ALLOCATE( sf_ssm_2d(ifpr)%fdta(jpi,jpj,1,2) , STAT=ierr1 ) 296 295 IF( ierr0 + ierr1 > 0 ) THEN … … 307 306 ENDIF 308 307 ! 309 CALL sbc_ssm( nit000 ) ! need to define ss?_m arrays used in iceistate308 CALL sbc_ssm( nit000, Kbb, Kmm ) ! need to define ss?_m arrays used in iceistate 310 309 l_initdone = .TRUE. 311 310 !
Note: See TracChangeset
for help on using the changeset viewer.
