Changeset 5407 for trunk/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
- Timestamp:
- 2015-06-11T21:13:22+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
r5215 r5407 36 36 PUBLIC sbc_ssm ! called by sbc 37 37 38 CHARACTER(len=100) :: cn_dir = './' !: Root directory for location of ssm files 39 LOGICAL :: ln_3d_uv = .true. !: specify whether input velocity data is 3D 40 INTEGER , SAVE :: nfld_3d 41 INTEGER , SAVE :: nfld_2d 42 43 INTEGER , PARAMETER :: jpfld_3d = 4 ! maximum number of files to read 44 INTEGER , PARAMETER :: jpfld_2d = 1 ! maximum number of files to read 45 INTEGER , SAVE :: jf_tem ! index of temperature 46 INTEGER , SAVE :: jf_sal ! index of salinity 47 INTEGER , SAVE :: jf_usp ! index of u velocity component 48 INTEGER , SAVE :: jf_vsp ! index of v velocity component 49 INTEGER , SAVE :: jf_ssh ! index of sea surface height 38 CHARACTER(len=100) :: cn_dir !: Root directory for location of ssm files 39 LOGICAL :: ln_3d_uve !: specify whether input velocity data is 3D 40 LOGICAL :: ln_read_frq !: specify whether we must read frq or not 41 LOGICAL :: l_initdone = .false. 42 INTEGER :: nfld_3d 43 INTEGER :: nfld_2d 44 45 INTEGER :: jf_tem ! index of temperature 46 INTEGER :: jf_sal ! index of salinity 47 INTEGER :: jf_usp ! index of u velocity component 48 INTEGER :: jf_vsp ! index of v velocity component 49 INTEGER :: jf_ssh ! index of sea surface height 50 INTEGER :: jf_e3t ! index of first T level thickness 51 INTEGER :: jf_frq ! index of fraction of qsr absorbed in the 1st T level 50 52 51 53 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_3d ! structure of input fields (file information, fields read) 52 54 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_2d ! structure of input fields (file information, fields read) 53 55 54 !! * Substitutions55 # include "domzgr_substitute.h90"56 # include "vectopt_loop_substitute.h90"57 56 !!---------------------------------------------------------------------- 58 57 !! NEMO/OFF 3.3 , NEMO Consortium (2010) … … 86 85 IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d ) !== read data at kt time step ==! 87 86 ! 88 IF( ln_3d_uv ) THEN87 IF( ln_3d_uve ) THEN 89 88 ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 90 89 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 90 IF( lk_vvl ) e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity 91 91 ELSE 92 92 ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 93 93 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 94 IF( lk_vvl ) e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity 94 95 ENDIF 95 96 ! … … 97 98 sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1) ! salinity 98 99 ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height 99 ! 100 tsn(:,:,1,jp_tem) = sst_m(:,:) 101 tsn(:,:,1,jp_sal) = sss_m(:,:) 100 IF( ln_read_frq ) frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height 101 ! 102 102 IF ( nn_ice == 1 ) THEN 103 tsn(:,:,1,jp_tem) = sst_m(:,:) 104 tsn(:,:,1,jp_sal) = sss_m(:,:) 103 105 tsb(:,:,1,jp_tem) = sst_m(:,:) 104 106 tsb(:,:,1,jp_sal) = sss_m(:,:) 105 107 ENDIF 106 ub (:,:,1 107 vb (:,:,1 108 ub (:,:,1) = ssu_m(:,:) 109 vb (:,:,1) = ssv_m(:,:) 108 110 109 111 IF(ln_ctl) THEN ! print control … … 113 115 CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m - : ', mask1=vmask, ovlap=1 ) 114 116 CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m - : ', mask1=tmask, ovlap=1 ) 117 IF( lk_vvl ) CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m - : ', mask1=tmask, ovlap=1 ) 118 IF( ln_read_frq ) CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m - : ', mask1=tmask, ovlap=1 ) 119 ENDIF 120 ! 121 IF( l_initdone ) THEN ! Mean value at each nn_fsbc time-step ! 122 CALL iom_put( 'ssu_m', ssu_m ) 123 CALL iom_put( 'ssv_m', ssv_m ) 124 CALL iom_put( 'sst_m', sst_m ) 125 CALL iom_put( 'sss_m', sss_m ) 126 CALL iom_put( 'ssh_m', ssh_m ) 127 IF( lk_vvl ) CALL iom_put( 'e3t_m', e3t_m ) 128 IF( ln_read_frq ) CALL iom_put( 'frq_m', frq_m ) 115 129 ENDIF 116 130 ! … … 138 152 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_2d ! array of namelist information on the fields to read 139 153 TYPE(FLD_N) :: sn_tem, sn_sal ! information about the fields to be read 140 TYPE(FLD_N) :: sn_usp, sn_vsp, sn_ssh 141 ! 142 NAMELIST/namsbc_sas/cn_dir, ln_3d_uv, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh 143 !!---------------------------------------------------------------------- 154 TYPE(FLD_N) :: sn_usp, sn_vsp 155 TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq 156 ! 157 NAMELIST/namsbc_sas/cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 158 !!---------------------------------------------------------------------- 159 160 IF( ln_rstart .AND. nn_components == jp_iam_sas ) RETURN 144 161 145 162 REWIND( numnam_ref ) ! Namelist namsbc_sas in reference namelist : Input fields … … 159 176 WRITE(numout,*) '~~~~~~~~~~~ ' 160 177 WRITE(numout,*) ' Namelist namsbc_sas' 178 WRITE(numout,*) ' Are we supplying a 3D u,v and e3 field ln_3d_uve = ', ln_3d_uve 179 WRITE(numout,*) ' Are we reading frq (fraction of qsr absorbed in the 1st T level) ln_read_frq = ', ln_read_frq 161 180 WRITE(numout,*) 162 181 ENDIF 163 164 182 ! 165 183 !! switch off stuff that isn't sensible with a standalone module … … 170 188 ln_apr_dyn = .FALSE. 171 189 ENDIF 172 IF( ln_dm2dc ) THEN173 IF( lwp ) WRITE(numout,*) 'No diurnal cycle needed with StandAlone Surface scheme'174 ln_dm2dc = .FALSE.175 ENDIF176 190 IF( ln_rnf ) THEN 177 191 IF( lwp ) WRITE(numout,*) 'No runoff needed with StandAlone Surface scheme' … … 190 204 nn_closea = 0 191 205 ENDIF 192 193 206 ! 194 207 !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 195 208 !! when we have other 3d arrays that we need to read in 196 209 !! so if a new field is added i.e. jf_new, just give it the next integer in sequence 197 !! for the corresponding dimension (currently if ln_3d_uv is true, 4 for 2d and 3 for 3d,198 !! alternatively if ln_3d_uv is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d,210 !! for the corresponding dimension (currently if ln_3d_uve is true, 4 for 2d and 3 for 3d, 211 !! alternatively if ln_3d_uve is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d, 199 212 !! and the rest of the logic should still work 200 213 ! 201 jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 202 ! 203 IF( ln_3d_uv ) THEN204 jf_usp = 1 ; jf_vsp = 2 205 nfld_3d = 2 206 nfld_2d = 3 214 jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 ; jf_frq = 4 ! default 2D fields index 215 ! 216 IF( ln_3d_uve ) THEN 217 jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3 ! define 3D fields index 218 nfld_3d = 2 + COUNT( (/lk_vvl/) ) ! number of 3D fields to read 219 nfld_2d = 3 + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 207 220 ELSE 208 jf_usp = 4 ; jf_vsp = 5 209 nfld_3d = 0 210 nfld_2d = 5 221 jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/lk_vvl/) ) ! update 2D fields index 222 nfld_3d = 0 ! no 3D fields to read 223 nfld_2d = 5 + COUNT( (/lk_vvl/) ) + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 211 224 ENDIF 212 225 … … 216 229 CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' ) ; RETURN 217 230 ENDIF 218 IF( ln_3d_uv ) THEN 219 slf_3d(jf_usp) = sn_usp 220 slf_3d(jf_vsp) = sn_vsp 221 ENDIF 231 slf_3d(jf_usp) = sn_usp 232 slf_3d(jf_vsp) = sn_vsp 233 IF( lk_vvl ) slf_3d(jf_e3t) = sn_e3t 222 234 ENDIF 223 235 … … 228 240 ENDIF 229 241 slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh 230 IF( .NOT. ln_3d_uv ) THEN 242 IF( ln_read_frq ) slf_2d(jf_frq) = sn_frq 243 IF( .NOT. ln_3d_uve ) THEN 231 244 slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 232 ENDIF 233 ENDIF 234 ! 245 IF( lk_vvl ) slf_2d(jf_e3t) = sn_e3t 246 ENDIF 247 ENDIF 248 ! 249 ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false. 235 250 IF( nfld_3d > 0 ) THEN 236 251 ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr ) ! set sf structure … … 265 280 ENDIF 266 281 ! 267 ! lim code currently uses surface temperature and salinity in tsn array for initialisation268 ! and ub, vb arrays in ice dynamics269 ! so allocate enough of arrays to use270 !271 ierr3 = 0272 jpm = MAX(jp_tem, jp_sal)273 ALLOCATE( tsn(jpi,jpj,1,jpm), STAT=ierr0 )274 ALLOCATE( ub(jpi,jpj,1) , STAT=ierr1 )275 ALLOCATE( vb(jpi,jpj,1) , STAT=ierr2 )276 IF ( nn_ice == 1 ) ALLOCATE( tsb(jpi,jpj,1,jpm), STAT=ierr3 )277 ierr = ierr0 + ierr1 + ierr2 + ierr3278 IF( ierr > 0 ) THEN279 CALL ctl_stop('sbc_ssm_init: unable to allocate surface arrays')280 ENDIF281 !282 282 ! finally tidy up 283 283 284 284 IF( nfld_3d > 0 ) DEALLOCATE( slf_3d, STAT=ierr ) 285 285 IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr ) 286 287 CALL sbc_ssm( nit000 ) ! need to define ss?_m arrays used in limistate 288 IF( .NOT. ln_read_frq ) frq_m(:,:) = 1. 289 l_initdone = .TRUE. 286 290 ! 287 291 END SUBROUTINE sbc_ssm_init
Note: See TracChangeset
for help on using the changeset viewer.