- Timestamp:
- 2012-04-24T15:52:15+02:00 (12 years ago)
- Location:
- branches/2012/dev_r3322_NOCS09_SAS/NEMOGCM/NEMO
- Files:
-
- 3 edited
-
OPA_SRC/SBC/sbcmod.F90 (modified) (2 diffs)
-
OPA_SRC/SBC/sbcssm.F90 (modified) (4 diffs)
-
SAS_SRC/sbcssm.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3322_NOCS09_SAS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r3294 r3364 76 76 !! 77 77 !! ** Method : Read the namsbc namelist and set derived parameters 78 !! Call init routines for all other SBC modules that have one 78 79 !! 79 80 !! ** Action : - read namsbc parameters … … 200 201 ENDIF 201 202 203 !!---------------------------------------------------------------------- 204 !! Other SBC modules to initialise come here 205 !!---------------------------------------------------------------------- 206 207 CALL sbc_ssm_init 208 202 209 IF( nn_ice == 4 ) CALL cice_sbc_init (nsbc) 203 210 ! 211 !!---------------------------------------------------------------------- 204 212 END SUBROUTINE sbc_init 205 213 -
branches/2012/dev_r3322_NOCS09_SAS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r3294 r3364 27 27 PUBLIC sbc_ssm ! routine called by step.F90 28 28 29 LOGICAL, SAVE :: l_ssm_mean = .FALSE. ! keep track of whether means have been read 30 ! from restart file 31 29 32 !! * Substitutions 30 33 # include "domzgr_substitute.h90" … … 54 57 !!--------------------------------------------------------------------- 55 58 ! ! ---------------------------------------- ! 56 IF( nn_fsbc == 1 ) THEN ! 59 IF( nn_fsbc == 1 ) THEN ! Instantaneous surface fields ! 57 60 ! ! ---------------------------------------- ! 58 IF( kt == nit000 ) THEN59 IF(lwp) WRITE(numout,*)60 IF(lwp) WRITE(numout,*) 'sbc_ssm : sea surface mean fields, nn_fsbc=1 : instantaneous values'61 IF(lwp) WRITE(numout,*) '~~~~~~~ '62 ENDIF63 !64 61 ssu_m(:,:) = ub(:,:,1) 65 62 ssv_m(:,:) = vb(:,:,1) … … 73 70 ! 74 71 ELSE 75 ! ! ---------------------------------------- !76 IF( kt == nit000 ) THEN ! Initialisation: 1st time-step!77 ! ! ---------------------------------------- !72 ! ! ----------------------------------------------- ! 73 IF( kt == nit000 && .NOT. l_ssm_mean ) THEN ! Initialisation: 1st time-step, no input means ! 74 ! ! ----------------------------------------------- ! 78 75 IF(lwp) WRITE(numout,*) 79 IF(lwp) WRITE(numout,*) 'sbc_ssm : sea surface mean fields' 80 ! 81 IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN 82 CALL iom_get( numror , 'nn_fsbc', zf_sbc ) ! sbc frequency of previous run 83 CALL iom_get( numror, jpdom_autoglo, 'ssu_m' , ssu_m ) ! sea surface mean velocity (T-point) 84 CALL iom_get( numror, jpdom_autoglo, 'ssv_m' , ssv_m ) ! " " velocity (V-point) 85 CALL iom_get( numror, jpdom_autoglo, 'sst_m' , sst_m ) ! " " temperature (T-point) 86 CALL iom_get( numror, jpdom_autoglo, 'sss_m' , sss_m ) ! " " salinity (T-point) 87 CALL iom_get( numror, jpdom_autoglo, 'ssh_m' , ssh_m ) ! " " height (T-point) 88 ! 89 IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN ! nn_fsbc has changed between 2 runs 90 IF(lwp) WRITE(numout,*) '~~~~~~~ restart with a change in the frequency of mean ', & 91 & 'from ', zf_sbc, ' to ', nn_fsbc 92 zcoef = REAL( nn_fsbc - 1, wp ) / zf_sbc 93 ssu_m(:,:) = zcoef * ssu_m(:,:) 94 ssv_m(:,:) = zcoef * ssv_m(:,:) 95 sst_m(:,:) = zcoef * sst_m(:,:) 96 sss_m(:,:) = zcoef * sss_m(:,:) 97 ssh_m(:,:) = zcoef * ssh_m(:,:) 98 ELSE 99 IF(lwp) WRITE(numout,*) '~~~~~~~ mean fields read in the ocean restart file' 100 ENDIF 101 ELSE 102 IF(lwp) WRITE(numout,*) '~~~~~~~ mean fields initialised to instantaneous values' 103 zcoef = REAL( nn_fsbc - 1, wp ) 104 ssu_m(:,:) = zcoef * ub(:,:,1) 105 ssv_m(:,:) = zcoef * vb(:,:,1) 106 sst_m(:,:) = zcoef * tsn(:,:,1,jp_tem) 107 sss_m(:,:) = zcoef * tsn(:,:,1,jp_sal) 108 ! ! removed inverse barometer ssh when Patm forcing is used 109 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 110 ELSE ; ssh_m(:,:) = zcoef * sshn(:,:) 111 ENDIF 112 76 IF(lwp) WRITE(numout,*) '~~~~~~~ mean fields initialised to instantaneous values' 77 zcoef = REAL( nn_fsbc - 1, wp ) 78 ssu_m(:,:) = zcoef * ub(:,:,1) 79 ssv_m(:,:) = zcoef * vb(:,:,1) 80 sst_m(:,:) = zcoef * tsn(:,:,1,jp_tem) 81 sss_m(:,:) = zcoef * tsn(:,:,1,jp_sal) 82 ! ! removed inverse barometer ssh when Patm forcing is used 83 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 84 ELSE ; ssh_m(:,:) = zcoef * sshn(:,:) 113 85 ENDIF 114 86 ! ! ---------------------------------------- ! … … 165 137 END SUBROUTINE sbc_ssm 166 138 139 SUBROUTINE sbc_ssm_init 140 !!---------------------------------------------------------------------- 141 !! *** ROUTINE sbc_ssm_init *** 142 !! 143 !! ** Purpose : Initialisation of the sbc data 144 !! 145 !! ** Action : - read parameters 146 !!---------------------------------------------------------------------- 147 REAL(wp) :: zcoef ! local scalar 148 !!---------------------------------------------------------------------- 149 150 IF( nn_fsbc == 1 ) THEN 151 ! 152 IF(lwp) WRITE(numout,*) 153 IF(lwp) WRITE(numout,*) 'sbc_ssm : sea surface mean fields, nn_fsbc=1 : instantaneous values' 154 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 155 ! 156 ELSE 157 ! 158 IF(lwp) WRITE(numout,*) 159 IF(lwp) WRITE(numout,*) 'sbc_ssm : sea surface mean fields' 160 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 161 ! 162 IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN 163 l_ssm_mean = .TRUE. 164 CALL iom_get( numror , 'nn_fsbc', zf_sbc ) ! sbc frequency of previous run 165 CALL iom_get( numror, jpdom_autoglo, 'ssu_m' , ssu_m ) ! sea surface mean velocity (T-point) 166 CALL iom_get( numror, jpdom_autoglo, 'ssv_m' , ssv_m ) ! " " velocity (V-point) 167 CALL iom_get( numror, jpdom_autoglo, 'sst_m' , sst_m ) ! " " temperature (T-point) 168 CALL iom_get( numror, jpdom_autoglo, 'sss_m' , sss_m ) ! " " salinity (T-point) 169 CALL iom_get( numror, jpdom_autoglo, 'ssh_m' , ssh_m ) ! " " height (T-point) 170 ! 171 IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN ! nn_fsbc has changed between 2 runs 172 IF(lwp) WRITE(numout,*) '~~~~~~~ restart with a change in the frequency of mean ', & 173 & 'from ', zf_sbc, ' to ', nn_fsbc 174 zcoef = REAL( nn_fsbc - 1, wp ) / zf_sbc 175 ssu_m(:,:) = zcoef * ssu_m(:,:) 176 ssv_m(:,:) = zcoef * ssv_m(:,:) 177 sst_m(:,:) = zcoef * sst_m(:,:) 178 sss_m(:,:) = zcoef * sss_m(:,:) 179 ssh_m(:,:) = zcoef * ssh_m(:,:) 180 ELSE 181 IF(lwp) WRITE(numout,*) '~~~~~~~ mean fields read in the ocean restart file' 182 ENDIF 183 ENDIF 184 ENDIF 185 ! 186 END SUBROUTINE sbc_ssm_init 187 167 188 !!====================================================================== 168 189 END MODULE sbcssm -
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.
