- Timestamp:
- 2012-04-24T15:52:15+02:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3322_NOCS09_SAS/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
r3363 r3364 33 33 PRIVATE 34 34 35 PUBLIC sbc_ssm_ sas_init ! called by opa.F9036 PUBLIC sbc_ssm ! called by step.F9035 PUBLIC sbc_ssm_init ! called by sbc_init 36 PUBLIC sbc_ssm ! called by sbc 37 37 38 38 CHARACTER(len=100) :: cn_dir = './' !: Root directory for location of ssm files … … 82 82 ! 83 83 IF( nn_timing == 1 ) CALL timing_start( 'sbc_ssm') 84 !85 IF( kt == nit000 ) THEN86 !87 !! switch off stuff that isn't sensible with a standalone module88 !! do it here rather than in sbc_ssm_init so that we don't have to rely on the order89 !! init routines are called in nemogcm90 !! note that we still need sbc_ssm called first in sbc91 !92 IF( ln_cpl ) THEN93 IF( lwp ) WRITE(numout,*) 'Coupled mode not sensible with StandAlone Surface scheme'94 ln_cpl = .FALSE.95 ENDIF96 IF( ln_apr_dyn ) THEN97 IF( lwp ) WRITE(numout,*) 'No atmospheric gradient needed with StandAlone Surface scheme'98 ln_apr_dyn = .FALSE.99 ENDIF100 IF( ln_dm2dc ) THEN101 IF( lwp ) WRITE(numout,*) 'No diurnal cycle needed with StandAlone Surface scheme'102 ln_dm2dc = .FALSE.103 ENDIF104 IF( ln_rnf ) THEN105 IF( lwp ) WRITE(numout,*) 'No runoff needed with StandAlone Surface scheme'106 ln_rnf = .FALSE.107 ENDIF108 IF( ln_ssr ) THEN109 IF( lwp ) WRITE(numout,*) 'No surface relaxation needed with StandAlone Surface scheme'110 ln_ssr = .FALSE.111 ENDIF112 IF( nn_fwb > 0 ) THEN113 IF( lwp ) WRITE(numout,*) 'No freshwater budget adjustment needed with StandAlone Surface scheme'114 nn_fwb = 0115 ENDIF116 IF( nn_closea > 0 ) THEN117 IF( lwp ) WRITE(numout,*) 'No closed seas adjustment needed with StandAlone Surface scheme'118 nn_closea = 0119 ENDIF120 ENDIF121 84 122 85 IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d ) !== read data at kt time step ==! … … 153 116 154 117 155 SUBROUTINE sbc_ssm_ sas_init118 SUBROUTINE sbc_ssm_init 156 119 !!---------------------------------------------------------------------- 157 120 !! *** ROUTINE sbc_ssm_init *** … … 166 129 INTEGER :: inum, idv, idimv, jpm ! local integer 167 130 !! 168 CHARACTER(len=100) :: cn_dir ! Root directory for location of core files169 TYPE(FLD_N), DIMENSION(jpfld_3d) :: slf_3d ! array of namelist information on the fields to read170 TYPE(FLD_N), DIMENSION(jpfld_2d) :: slf_2d ! array of namelist information on the fields to read131 CHARACTER(len=100) :: cn_dir ! Root directory for location of core files 132 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_3d ! array of namelist information on the fields to read 133 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_2d ! array of namelist information on the fields to read 171 134 TYPE(FLD_N) :: sn_tem, sn_sal ! information about the fields to be read 172 135 TYPE(FLD_N) :: sn_usp, sn_vsp, sn_ssh 173 136 ! 174 NAMELIST/namsbc_ssm _sas/cn_dir, ln_3d_uv, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh137 NAMELIST/namsbc_ssm/cn_dir, ln_3d_uv, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh 175 138 176 139 !!---------------------------------------------------------------------- … … 188 151 ! 189 152 REWIND( numnam ) ! read in namlist namsbc_ssm 190 READ ( numnam, namsbc_ssm _sas)153 READ ( numnam, namsbc_ssm ) 191 154 ! ! store namelist information in an array 192 155 ! ! Control print 193 156 IF(lwp) THEN 194 157 WRITE(numout,*) 195 WRITE(numout,*) 'sbc_ssm _sas: standalone surface scheme '158 WRITE(numout,*) 'sbc_ssm : standalone surface scheme ' 196 159 WRITE(numout,*) '~~~~~~~~~~~ ' 197 WRITE(numout,*) ' Namelist namsbc_ssm _sas'160 WRITE(numout,*) ' Namelist namsbc_ssm' 198 161 WRITE(numout,*) 199 162 ENDIF 163 164 ! 165 !! switch off stuff that isn't sensible with a standalone module 166 !! note that we need sbc_ssm called first in sbc 167 ! 168 IF( ln_cpl ) THEN 169 IF( lwp ) WRITE(numout,*) 'Coupled mode not sensible with StandAlone Surface scheme' 170 ln_cpl = .FALSE. 171 ENDIF 172 IF( ln_apr_dyn ) THEN 173 IF( lwp ) WRITE(numout,*) 'No atmospheric gradient needed with StandAlone Surface scheme' 174 ln_apr_dyn = .FALSE. 175 ENDIF 176 IF( ln_dm2dc ) THEN 177 IF( lwp ) WRITE(numout,*) 'No diurnal cycle needed with StandAlone Surface scheme' 178 ln_dm2dc = .FALSE. 179 ENDIF 180 IF( ln_rnf ) THEN 181 IF( lwp ) WRITE(numout,*) 'No runoff needed with StandAlone Surface scheme' 182 ln_rnf = .FALSE. 183 ENDIF 184 IF( ln_ssr ) THEN 185 IF( lwp ) WRITE(numout,*) 'No surface relaxation needed with StandAlone Surface scheme' 186 ln_ssr = .FALSE. 187 ENDIF 188 IF( nn_fwb > 0 ) THEN 189 IF( lwp ) WRITE(numout,*) 'No freshwater budget adjustment needed with StandAlone Surface scheme' 190 nn_fwb = 0 191 ENDIF 192 IF( nn_closea > 0 ) THEN 193 IF( lwp ) WRITE(numout,*) 'No closed seas adjustment needed with StandAlone Surface scheme' 194 nn_closea = 0 195 ENDIF 196 200 197 ! 198 !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 199 !! when we have other 3d arrays that we need to read in 200 !! so if a new field is added i.e. jf_new, just give it the next integer in sequence 201 !! for the corresponding dimension (currently if ln_3d_uv is true, 4 for 2d and 3 for 3d, 202 !! alternatively if ln_3d_uv is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d, 203 !! and the rest of the logic should still work 204 ! 201 205 jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 202 206 ! … … 205 209 nfld_3d = 2 206 210 nfld_2d = 3 207 slf_3d(jf_usp) = sn_usp ; slf_3d(jf_vsp) = sn_vsp208 211 ELSE 209 212 jf_usp = 4 ; jf_vsp = 5 210 213 nfld_3d = 0 211 214 nfld_2d = 5 212 slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 213 ENDIF 214 215 slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh 215 ENDIF 216 217 IF( nfld_3d > 0 ) THEN 218 ALLOCATE( slf_3d(nfld_3d), STAT=ierr ) ! set slf structure 219 IF( ierr > 0 ) THEN 220 CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' ) ; RETURN 221 ENDIF 222 IF( ln_3d_uv ) THEN 223 slf_3d(jf_usp) = sn_usp 224 slf_3d(jf_vsp) = sn_vsp 225 ENDIF 226 ENDIF 227 228 IF( nfld_2d > 0 ) THEN 229 ALLOCATE( slf_2d(nfld_2d), STAT=ierr ) ! set slf structure 230 IF( ierr > 0 ) THEN 231 CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 2d structure' ) ; RETURN 232 ENDIF 233 slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh 234 IF( .NOT. ln_3d_uv ) THEN 235 slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 236 ENDIF 237 ENDIF 216 238 ! 217 239 IF( nfld_3d > 0 ) THEN 218 240 ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr ) ! set sf structure 219 241 IF( ierr > 0 ) THEN 220 CALL ctl_stop( 'sbc_ssm : unable to allocate sf structure' ) ; RETURN242 CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf structure' ) ; RETURN 221 243 ENDIF 222 244 DO ifpr = 1, nfld_3d … … 234 256 ALLOCATE( sf_ssm_2d(nfld_2d), STAT=ierr ) ! set sf structure 235 257 IF( ierr > 0 ) THEN 236 CALL ctl_stop( 'sbc_ssm : unable to allocate sf 2d structure' ) ; RETURN258 CALL ctl_stop( 'sbc_ssm_init: unable to allocate sf 2d structure' ) ; RETURN 237 259 ENDIF 238 260 DO ifpr = 1, nfld_2d … … 260 282 ENDIF 261 283 ! 262 END SUBROUTINE sbc_ssm_sas_init 284 ! finally tidy up 285 286 IF( nfld_3d > 0 ) DEALLOCATE( slf_3d, STAT=ierr ) 287 IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr ) 288 ! 289 END SUBROUTINE sbc_ssm_init 263 290 264 291 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
