Changeset 2188 for branches/dev_r2174_DCY
- Timestamp:
- 2010-10-08T10:32:36+02:00 (14 years ago)
- Location:
- branches/dev_r2174_DCY/NEMO/OPA_SRC/SBC
- Files:
-
- 4 edited
-
sbcblk_core.F90 (modified) (9 diffs)
-
sbcdcy.F90 (modified) (9 diffs)
-
sbcflx.F90 (modified) (5 diffs)
-
sbcmod.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2174_DCY/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r2187 r2188 12 12 !! 3.0 ! 2006-06 (G. Madec) sbc rewritting 13 13 !! 3.2 ! 2009-04 (B. Lemaire) Introduce iom_put 14 !! 3.3 ! 2010-10 (S. Masson) add diurnal cycle 14 15 !!---------------------------------------------------------------------- 15 16 … … 26 27 USE fldread ! read input fields 27 28 USE sbc_oce ! Surface boundary condition: ocean fields 28 USE sbcdcy ! surface forcing: diurnal cycle29 USE sbcdcy ! surface boundary condition: diurnal cycle 29 30 USE iom ! I/O manager library 30 31 USE in_out_manager ! I/O manager … … 35 36 USE sbc_ice ! Surface boundary condition: ice fields 36 37 #endif 37 38 38 39 39 IMPLICIT NONE … … 63 63 REAL(wp), PARAMETER :: Cice = 1.63e-3 ! transfer coefficient over ice 64 64 65 ! !!* Namelist namsbc_core : CORE bulk parameters66 LOGICAL :: ln_2m = .FALSE. 67 LOGICAL :: ln_taudif = .FALSE. 68 REAL(wp) :: rn_pfac = 1. 65 ! !!* Namelist namsbc_core : CORE bulk parameters 66 LOGICAL :: ln_2m = .FALSE. ! logical flag for height of air temp. and hum 67 LOGICAL :: ln_taudif = .FALSE. ! logical flag to use the "mean of stress module - module of mean stress" data 68 REAL(wp) :: rn_pfac = 1. ! multiplication factor for precipitation 69 69 70 70 !! * Substitutions … … 72 72 # include "vectopt_loop_substitute.h90" 73 73 !!---------------------------------------------------------------------- 74 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)74 !! NEMO/OPA 3.3 , NEMO-consortium (2010) 75 75 !! $Id$ 76 76 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 77 77 !!---------------------------------------------------------------------- 78 79 78 CONTAINS 80 79 … … 145 144 sn_tdif = FLD_N( 'taudif' , 24 , 'taudif' , .true. , .false. , 'yearly' , '' , '' ) 146 145 ! 147 REWIND( numnam ) ! ...read in namlist namsbc_core146 REWIND( numnam ) ! read in namlist namsbc_core 148 147 READ ( numnam, namsbc_core ) 149 ! 150 ! do we plan to use ln_dm2dc with non-daily forcing? 151 IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 ) & 148 ! ! check: do we plan to use ln_dm2dc with non-daily forcing? 149 IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 ) & 152 150 & CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 153 151 IF( ln_dm2dc .AND. sn_qsr%ln_tint ) THEN … … 156 154 sn_qsr%ln_tint = .false. 157 155 ENDIF 158 ! 159 ! store namelist information in an array 156 ! ! store namelist information in an array 160 157 slf_i(jp_wndi) = sn_wndi ; slf_i(jp_wndj) = sn_wndj 161 158 slf_i(jp_qsr ) = sn_qsr ; slf_i(jp_qlw ) = sn_qlw … … 163 160 slf_i(jp_prec) = sn_prec ; slf_i(jp_snow) = sn_snow 164 161 slf_i(jp_tdif) = sn_tdif 165 ! 166 ! do we use HF tau information? 167 lhftau = ln_taudif 162 ! 163 lhftau = ln_taudif ! do we use HF tau information? 168 164 jfld = jpfld - COUNT( (/.NOT. lhftau/) ) 169 165 ! 170 ! set sf structure 171 ALLOCATE( sf(jfld), STAT=ierror ) 166 ALLOCATE( sf(jfld), STAT=ierror ) ! set sf structure 172 167 IF( ierror > 0 ) THEN 173 168 CALL ctl_stop( 'sbc_blk_core: unable to allocate sf structure' ) ; RETURN … … 177 172 ALLOCATE( sf(ifpr)%fdta(jpi,jpj,2) ) 178 173 END DO 179 ! 180 ! fill sf with slf_i and control print 174 ! ! fill sf with slf_i and control print 181 175 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulation for ocean surface boundary condition', 'namsbc_core' ) 182 176 ! 183 177 ENDIF 184 178 185 CALL fld_read( kt, nn_fsbc, sf )! input fields provided at the current time-step186 187 IF( ln_dm2dc ) CALL sbc_dcy ( kt , sf(jp_qsr)%fnow ) ! modify sf(jp_qsr)%fnow fordiurnal cycle179 CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step 180 181 IF( ln_dm2dc ) CALL sbc_dcy ( kt , sf(jp_qsr)%fnow ) ! modify now Qsr to include the diurnal cycle 188 182 189 183 #if defined key_lim3 190 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:) 184 tatm_ice(:,:) = sf(jp_tair)%fnow(:,:) ! LIM3: make Tair available in sea-ice 191 185 #endif 192 193 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 194 CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) ! compute the surface ocean fluxes using CLIO bulk formulea 195 ENDIF 196 ! ! using CORE bulk formulea 186 ! ! surface ocean fluxes computed with CLIO bulk formulea 187 IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m ) 188 ! 197 189 END SUBROUTINE sbc_blk_core 198 190 -
branches/dev_r2174_DCY/NEMO/OPA_SRC/SBC/sbcdcy.F90
r2187 r2188 4 4 !! Ocean forcing: compute the diurnal cycle 5 5 !!====================================================================== 6 !! History : 8.2! 2005-02 (D. Bernie) Original code7 !! 9.0 ! 2006-02 (S. Masson, G. Madec) adaptation to OPA98 !! 3.1 ! 2009-07 (J.M. Molines) adaptation to nemo3.16 !! History : OPA ! 2005-02 (D. Bernie) Original code 7 !! NEMO 2.0 ! 2006-02 (S. Masson, G. Madec) adaptation to NEMO 8 !! 3.1 ! 2009-07 (J.M. Molines) adaptation to v3.1 9 9 !!---------------------------------------------------------------------- 10 10 … … 20 20 IMPLICIT NONE 21 21 PRIVATE 22 INTEGER :: idayqsr ! day when parameters were computed 23 REAL(wp), DIMENSION(jpi,jpj) :: zaaa, zbbb, zccc, zab, ztmd, zdawn, zdusk, zscal ! parameters to compute the diurnal cycle 24 REAL(wp), DIMENSION(jpi,jpj) :: qsr_daily ! to hold daily mean QSR 22 INTEGER :: nday_qsr ! day when parameters were computed 23 REAL(wp), DIMENSION(jpi,jpj) :: raa , rbb , rcc , rab ! parameters used to compute the diurnal cycle 24 REAL(wp), DIMENSION(jpi,jpj) :: rtmd, rdawn, rdusk, rscal ! - - - - - 25 REAL(wp), DIMENSION(jpi,jpj) :: qsr_daily ! to hold daily mean QSR 25 26 26 PUBLIC sbc_dcy! routine called by sbc27 28 !!---------------------------------------------------------------------- 29 !! NEMO/OPA 3.3 , LOCEAN-IPSL(2010)27 PUBLIC sbc_dcy ! routine called by sbc 28 29 !!---------------------------------------------------------------------- 30 !! NEMO/OPA 3.3 , NEMO-consortium (2010) 30 31 !! $Id$ 31 32 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 32 33 !!---------------------------------------------------------------------- 33 34 34 CONTAINS 35 35 … … 40 40 !! ** Purpose : introduce a diurnal cycle of qsr from daily values 41 41 !! 42 !! ** Method : see Appendix A of 43 !! Bernie, DJ, Guilyardi, E, Madec, G, Slingo, JM and Woolnough, SJ 44 !! Impact of resolving the diurnal cycle in an ocean--atmosphere GCM. Part 1: a diurnally forced OGCM 45 !! Climate Dynamics 29:6, 575-590 (2007) 42 !! ** Method : see Appendix A of Bernie et al. 2007. 46 43 !! 47 44 !! ** Action : redistribute daily QSR on each time step following the diurnal cycle 45 !! 46 !! reference : Bernie, DJ, E Guilyardi, G Madec, JM Slingo, and SJ Woolnough, 2007 47 !! Impact of resolving the diurnal cycle in an ocean--atmosphere GCM. 48 !! Part 1: a diurnally forced OGCM. Climate Dynamics 29:6, 575-590. 48 49 !!---------------------------------------------------------------------- 49 INTEGER, INTENT( in ) :: kt ! ocean time-step index 50 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: pqsr ! QSR flux with diurnal cycle 51 !! 52 INTEGER :: ji, jj ! dummy loop indices 53 REAL(wp) :: fintegral, pt1, pt2, paaa, pbbb, pccc ! 50 INTEGER, INTENT(in ) :: kt ! ocean time-step index 51 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pqsr ! QSR flux with diurnal cycle 52 !! 53 INTEGER :: ji, jj ! dummy loop indices 54 54 REAL(wp) :: ztwopi, zinvtwopi, zconvrad 55 55 REAL(wp) :: zlo, zup, zlousd, zupusd 56 56 REAL(wp) :: zdsws, zdecrad, ztx 57 57 REAL(wp) :: ztmp, ztmp1, ztmp2, ztest 58 !!--------------------------------------------------------------------- 59 60 !---------------------------------------------------------------------- 61 ! statement functions 62 63 fintegral(pt1, pt2, paaa, pbbb, pccc) = & 58 !---------------------------statement functions------------------------ 59 REAL(wp) :: fintegral, pt1, pt2, paaa, pbbb, pccc ! dummy statement function arguments 60 fintegral( pt1, pt2, paaa, pbbb, pccc ) = & 64 61 & paaa * pt2 + zinvtwopi * pbbb * SIN(pccc + ztwopi * pt2) & 65 62 & - paaa * pt1 - zinvtwopi * pbbb * SIN(pccc + ztwopi * pt1) 66 ! ----------------------------------------------------------------------63 !!--------------------------------------------------------------------- 67 64 68 65 ! Initialization … … 77 74 78 75 ! 79 IF (kt == nit000) THEN 80 ! 76 IF( kt == nit000 ) THEN ! first time step only 81 77 IF(lwp) THEN 82 78 WRITE(numout,*) … … 85 81 WRITE(numout,*) 86 82 ENDIF 87 idayqsr = 088 ! Compute Cneeded to compute the time integral of the diurnal cycle89 zccc(:,:) = zconvrad * glamt(:,:) - rpi83 nday_qsr = 0 84 ! Compute rcc needed to compute the time integral of the diurnal cycle 85 rcc(:,:) = zconvrad * glamt(:,:) - rpi 90 86 ! time of midday 91 ztmd(:,:) = 0.5 - glamt(:,:) / 360.92 ztmd(:,:) = MOD((ztmd(:,:) + 1.), 1.)87 rtmd(:,:) = 0.5 - glamt(:,:) / 360. 88 rtmd(:,:) = MOD( (rtmd(:,:) + 1.), 1. ) 93 89 ENDIF 94 90 … … 99 95 100 96 ! nday is the number of days since the beginning of the current month 101 IF( idayqsr /= nday ) THEN97 IF( nday_qsr /= nday ) THEN 102 98 ! save the day of the year and the daily mean of qsr 103 idayqsr = nday99 nday_qsr = nday 104 100 ! number of days since the previous winter solstice (supposed to be always 21 December) 105 101 zdsws = 11 + nday_year … … 113 109 DO ji = 1, jpi 114 110 ztmp = zconvrad * gphit(ji,jj) 115 zaaa(ji,jj) = SIN(ztmp) * SIN(zdecrad)116 zbbb(ji,jj) = COS(ztmp) * COS(zdecrad)111 raa(ji,jj) = SIN( ztmp ) * SIN( zdecrad ) 112 rbb(ji,jj) = COS( ztmp ) * COS( zdecrad ) 117 113 END DO 118 114 END DO … … 120 116 ! Compute the time of dawn and dusk 121 117 122 ! zab to test if the day time is equal to 0, less than 24h of full day123 zab(:,:) = -zaaa(:,:) / zbbb(:,:)118 ! rab to test if the day time is equal to 0, less than 24h of full day 119 rab(:,:) = -raa(:,:) / rbb(:,:) 124 120 DO jj = 1, jpj 125 121 DO ji = 1, jpi 126 IF ( ABS(zab(ji,jj)) < 1 ) THEN 127 ! day duration is less than 24h 122 IF ( ABS(rab(ji,jj)) < 1 ) THEN ! day duration is less than 24h 128 123 ! When is it night? 129 ztx = zinvtwopi * (ACOS( zab(ji,jj)) - zccc(ji,jj))130 ztest = - zbbb(ji,jj) * SIN( zccc(ji,jj) + ztwopi * ztx )124 ztx = zinvtwopi * (ACOS(rab(ji,jj)) - rcc(ji,jj)) 125 ztest = -rbb(ji,jj) * SIN( rcc(ji,jj) + ztwopi * ztx ) 131 126 ! is it dawn or dusk? 132 127 IF ( ztest > 0 ) THEN 133 zdawn(ji,jj) = ztx134 zdusk(ji,jj) = ztmd(ji,jj) + ( ztmd(ji,jj) - zdawn(ji,jj) )128 rdawn(ji,jj) = ztx 129 rdusk(ji,jj) = rtmd(ji,jj) + ( rtmd(ji,jj) - rdawn(ji,jj) ) 135 130 ELSE 136 zdusk(ji,jj) = ztx137 zdawn(ji,jj) = ztmd(ji,jj) - ( zdusk(ji,jj) - ztmd(ji,jj) )131 rdusk(ji,jj) = ztx 132 rdawn(ji,jj) = rtmd(ji,jj) - ( rdusk(ji,jj) - rtmd(ji,jj) ) 138 133 ENDIF 139 134 ELSE 140 zdawn(ji,jj) = ztmd(ji,jj) + 0.5141 zdusk(ji,jj) = zdawn(ji,jj)135 rdawn(ji,jj) = rtmd(ji,jj) + 0.5 136 rdusk(ji,jj) = rdawn(ji,jj) 142 137 ENDIF 143 138 END DO 144 139 END DO 145 zdawn(:,:) = MOD((zdawn(:,:) + 1.), 1.)146 zdusk(:,:) = MOD((zdusk(:,:) + 1.), 1.)140 rdawn(:,:) = MOD((rdawn(:,:) + 1.), 1.) 141 rdusk(:,:) = MOD((rdusk(:,:) + 1.), 1.) 147 142 148 143 149 144 ! 2.2 Compute the scalling function: 150 145 ! S* = the inverse of the time integral of the diurnal cycle from dawm to dusk 151 152 146 DO jj = 1, jpj 153 147 DO ji = 1, jpi 154 IF ( ABS(zab(ji,jj)) < 1 ) THEN 155 ! day duration is less than 24h 156 IF ( zdawn(ji,jj) < zdusk(ji,jj) ) THEN 157 ! day time in one part 158 zscal(ji,jj) = fintegral(zdawn(ji,jj), zdusk(ji,jj), zaaa(ji,jj), zbbb(ji,jj), zccc(ji,jj)) 159 zscal(ji,jj) = 1. / zscal(ji,jj) 160 ELSE 161 ! day time in two parts 162 zscal(ji,jj) = fintegral(0., zdusk(ji,jj), zaaa(ji,jj), zbbb(ji,jj), zccc(ji,jj)) & 163 & + fintegral(zdawn(ji,jj), 1., zaaa(ji,jj), zbbb(ji,jj), zccc(ji,jj)) 164 zscal(ji,jj) = 1. / zscal(ji,jj) 148 IF ( ABS(rab(ji,jj)) < 1 ) THEN ! day duration is less than 24h 149 IF ( rdawn(ji,jj) < rdusk(ji,jj) ) THEN ! day time in one part 150 rscal(ji,jj) = fintegral(rdawn(ji,jj), rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 151 rscal(ji,jj) = 1. / rscal(ji,jj) 152 ELSE ! day time in two parts 153 rscal(ji,jj) = fintegral(0., rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) & 154 & + fintegral(rdawn(ji,jj), 1., raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 155 rscal(ji,jj) = 1. / rscal(ji,jj) 165 156 ENDIF 166 157 ELSE 167 IF ( zaaa(ji,jj) > zbbb(ji,jj) ) THEN 168 ! 24h day 169 zscal(ji,jj) = fintegral(0., 1., zaaa(ji,jj), zbbb(ji,jj), zccc(ji,jj)) 170 zscal(ji,jj) = 1. / zscal(ji,jj) 171 ELSE 172 ! No day 173 zscal(ji,jj) = 0. 158 IF ( raa(ji,jj) > rbb(ji,jj) ) THEN ! 24h day 159 rscal(ji,jj) = fintegral(0., 1., raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 160 rscal(ji,jj) = 1. / rscal(ji,jj) 161 ELSE ! No day 162 rscal(ji,jj) = 0.e0 174 163 ENDIF 175 164 ENDIF … … 178 167 ! 179 168 ztmp = rday / rdt 180 zscal(:,:) = zscal(:,:) * ztmp169 rscal(:,:) = rscal(:,:) * ztmp 181 170 182 171 ENDIF 183 172 184 ! 3. compute qsr with the diurnal cycle185 ! ----------------------- 173 ! 3. update qsr with the diurnal cycle 174 ! ------------------------------------ 186 175 187 176 DO jj = 1, jpj 188 177 DO ji = 1, jpi 189 IF ( ABS(zab(ji,jj)) < 1 ) THEN 190 ! day duration is less than 24h 191 IF ( zdawn(ji,jj) < zdusk(ji,jj) ) THEN 192 ! day time in one part 193 zlousd = MAX(zlo, zdawn(ji,jj)) 194 zlousd = MIN(zlousd, zup) 195 zupusd = MIN(zup, zdusk(ji,jj)) 196 zupusd = MAX(zupusd, zlo) 197 ztmp = fintegral(zlousd, zupusd, zaaa(ji,jj), zbbb(ji,jj), zccc(ji,jj)) 198 pqsr(ji,jj) = qsr_daily(ji,jj) * ztmp * zscal(ji,jj) 199 ELSE 200 ! day time in two parts 201 zlousd = MIN(zlo, zdusk(ji,jj)) 202 zupusd = MIN(zup, zdusk(ji,jj)) 203 ztmp1 = fintegral(zlousd, zupusd, zaaa(ji,jj), zbbb(ji,jj), zccc(ji,jj)) 204 zlousd = MAX(zlo, zdawn(ji,jj)) 205 zupusd = MAX(zup, zdawn(ji,jj)) 206 ztmp2 = fintegral(zlousd, zupusd, zaaa(ji,jj), zbbb(ji,jj), zccc(ji,jj)) 207 ztmp = ztmp1 + ztmp2 208 pqsr(ji,jj) = qsr_daily(ji,jj) * ztmp * zscal(ji,jj) 209 ENDIF 210 ELSE 211 IF ( zaaa(ji,jj) > zbbb(ji,jj) ) THEN 212 ! 24h day 213 ztmp = fintegral(zlo, zup, zaaa(ji,jj), zbbb(ji,jj), zccc(ji,jj)) 214 pqsr(ji,jj) = qsr_daily(ji,jj) * ztmp * zscal(ji,jj) 215 ELSE 216 ! No day 217 pqsr(ji,jj) = 0. 218 ENDIF 178 IF( ABS(rab(ji,jj)) < 1 ) THEN ! day duration is less than 24h 179 ! 180 IF( rdawn(ji,jj) < rdusk(ji,jj) ) THEN ! day time in one part 181 zlousd = MAX(zlo, rdawn(ji,jj)) 182 zlousd = MIN(zlousd, zup) 183 zupusd = MIN(zup, rdusk(ji,jj)) 184 zupusd = MAX(zupusd, zlo) 185 ztmp = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 186 pqsr(ji,jj) = qsr_daily(ji,jj) * ztmp * rscal(ji,jj) 187 ! 188 ELSE ! day time in two parts 189 zlousd = MIN(zlo, rdusk(ji,jj)) 190 zupusd = MIN(zup, rdusk(ji,jj)) 191 ztmp1 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 192 zlousd = MAX(zlo, rdawn(ji,jj)) 193 zupusd = MAX(zup, rdawn(ji,jj)) 194 ztmp2 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 195 ztmp = ztmp1 + ztmp2 196 pqsr(ji,jj) = qsr_daily(ji,jj) * ztmp * rscal(ji,jj) 197 ENDIF 198 ELSE ! 24h light or 24h night 199 ! 200 IF( raa(ji,jj) > rbb(ji,jj) ) THEN ! 24h day 201 ztmp = fintegral(zlo, zup, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 202 pqsr(ji,jj) = qsr_daily(ji,jj) * ztmp * rscal(ji,jj) 203 ! 204 ELSE ! No day 205 pqsr(ji,jj) = 0.e0 206 ENDIF 219 207 ENDIF 220 208 END DO 221 209 END DO 222 210 ! 223 211 END SUBROUTINE sbc_dcy 224 212 -
branches/dev_r2174_DCY/NEMO/OPA_SRC/SBC/sbcflx.F90
r2187 r2188 4 4 !! Ocean forcing: momentum, heat and freshwater flux formulation 5 5 !!===================================================================== 6 !! History : 9.0 ! 06-06 (G. Madec) Original code 6 !! History : 1.0 ! 2006-06 (G. Madec) Original code 7 !! 3.3 ! 2010-10 (S. Masson) add diurnal cycle 7 8 !!---------------------------------------------------------------------- 8 9 9 10 !!---------------------------------------------------------------------- 10 11 !! namflx : flux formulation namlist 11 !! sbc_flx : flux formulation as ocean surface boundary condition 12 !! (forced mode, fluxes read in NetCDF files) 13 !!---------------------------------------------------------------------- 14 !! question diverses 15 !! * ajouter un test sur la division entier de freqh et rdttra ??? 16 !! ** ajoute dans namelist: 1 year forcing files 17 !! or forcing file starts at the begining of the run 18 !! *** we assume that the forcing file start and end with the previous 19 !! year last record and the next year first record (useful for 20 !! time interpolation, required even if no time interp???) 21 !! * ajouter un test sur la division de la frequence en pas de temps 22 !! ==> daymod ajout de nsec_year = number of second since the begining of the year 23 !! assumed to be 0 at 0h january the 1st (i.e. 24h december the 31) 24 !! 25 !! *** regrouper dtatem et dtasal 12 !! sbc_flx : flux formulation as ocean surface boundary condition (forced mode, fluxes read in NetCDF files) 26 13 !!---------------------------------------------------------------------- 27 14 USE oce ! ocean dynamics and tracers 28 15 USE dom_oce ! ocean space and time domain 29 USE sbc_oce ! Surface boundary condition: ocean fields 16 USE sbc_oce ! surface boundary condition: ocean fields 17 USE sbcdcy ! surface boundary condition: diurnal cycle on qsr 30 18 USE phycst ! physical constants 31 USE sbcdcy ! diurnal cycle on qsr32 19 USE fldread ! read input fields 33 20 USE iom ! IOM library … … 53 40 # include "vectopt_loop_substitute.h90" 54 41 !!---------------------------------------------------------------------- 55 !! OPA 9.0 , LOCEAN-IPSL (2006)42 !! NEMO/OPA 3.3 , NEMO-consortium (2010) 56 43 !! $Id$ 57 44 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 58 45 !!---------------------------------------------------------------------- 59 60 46 CONTAINS 61 47 … … 99 85 NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp 100 86 !!--------------------------------------------------------------------- 101 ! ! ====================== ! 102 IF( kt == nit000 ) THEN ! First call kt=nit000 ! 103 ! ! ====================== ! 87 ! 88 IF( kt == nit000 ) THEN ! First call kt=nit000 104 89 ! set file information 105 90 cn_dir = './' ! directory in which the model is executed 106 91 ! ... default values (NB: frequency positive => hours, negative => months) 107 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation!108 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs!109 sn_utau = FLD_N( 'utau' , 24 , 'utau' , .false. , .false. , 'yearly' , '' , '')110 sn_vtau = FLD_N( 'vtau' , 24 , 'vtau' , .false. , .false. , 'yearly' , '' , '')111 sn_qtot = FLD_N( 'qtot' , 24 , 'qtot' , .false. , .false. , 'yearly' , '' , '')112 sn_qsr = FLD_N( 'qsr' , 24 , 'qsr' , .false. , .false. , 'yearly' , '' , '')113 sn_emp = FLD_N( 'emp' , 24 , 'emp' , .false. , .false. , 'yearly' , '' , '')114 115 REWIND ( numnam ) ! ...read in namlist namflx92 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 93 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 94 sn_utau = FLD_N( 'utau' , 24 , 'utau' , .false. , .false. , 'yearly' , '' , '' ) 95 sn_vtau = FLD_N( 'vtau' , 24 , 'vtau' , .false. , .false. , 'yearly' , '' , '' ) 96 sn_qtot = FLD_N( 'qtot' , 24 , 'qtot' , .false. , .false. , 'yearly' , '' , '' ) 97 sn_qsr = FLD_N( 'qsr' , 24 , 'qsr' , .false. , .false. , 'yearly' , '' , '' ) 98 sn_emp = FLD_N( 'emp' , 24 , 'emp' , .false. , .false. , 'yearly' , '' , '' ) 99 ! 100 REWIND ( numnam ) ! read in namlist namflx 116 101 READ ( numnam, namsbc_flx ) 117 118 ! do we plan to use ln_dm2dc with non-daily forcing?102 ! 103 ! ! check: do we plan to use ln_dm2dc with non-daily forcing? 119 104 IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 ) & 120 105 & CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 121 122 ! store namelist information in an array106 ! 107 ! ! store namelist information in an array 123 108 slf_i(jp_utau) = sn_utau ; slf_i(jp_vtau) = sn_vtau 124 109 slf_i(jp_qtot) = sn_qtot ; slf_i(jp_qsr ) = sn_qsr 125 110 slf_i(jp_emp ) = sn_emp 126 127 ! set sf structure 128 ALLOCATE( sf(jpfld), STAT=ierror ) 111 ! 112 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure 129 113 IF( ierror > 0 ) THEN 130 114 CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN 131 115 ENDIF 132 116 DO ji= 1, jpfld 133 ALLOCATE( sf(ji)%fnow(jpi,jpj) )117 ALLOCATE( sf(ji)%fnow(jpi,jpj) ) 134 118 ALLOCATE( sf(ji)%fdta(jpi,jpj,2) ) 135 119 END DO 136 137 138 ! fill sf with slf_i and control print 120 ! ! fill sf with slf_i and control print 139 121 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' ) 140 122 ! 141 123 ENDIF 142 124 143 CALL fld_read( kt, nn_fsbc, sf ) ! Read input fields and provides the144 ! ! input fields at the current time-step145 IF( ln_dm2dc ) CALL sbc_dcy( kt , sf(jp_qsr)%fnow ) ! modify sf(jp_qsr)%fnow fordiurnal cycle125 CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step 126 127 IF( ln_dm2dc ) CALL sbc_dcy( kt , sf(jp_qsr)%fnow ) ! modify now Qsr to include the diurnal cycle 146 128 147 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 148 ! 149 ! set the ocean fluxes from read fields 129 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! update ocean fluxes at each SBC frequency 150 130 !CDIR COLLAPSE 151 DO jj = 1, jpj 131 DO jj = 1, jpj ! set the ocean fluxes from read fields 152 132 DO ji = 1, jpi 153 133 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj) … … 158 138 END DO 159 139 END DO 160 161 ! module of wind stress and wind speed at T-point 162 zcoef = 1. / ( zrhoa * zcdrag ) 140 ! ! module of wind stress and wind speed at T-point 141 zcoef = 1. / ( zrhoa * zcdrag ) 163 142 !CDIR NOVERRCHK 164 143 DO jj = 2, jpjm1 … … 174 153 CALL lbc_lnk( taum(:,:), 'T', 1. ) ; CALL lbc_lnk( wndm(:,:), 'T', 1. ) 175 154 176 ! Initialization of emps (when no ice model) 177 emps(:,:) = emp (:,:) 155 emps(:,:) = emp (:,:) ! Initialization of emps (needed when no ice model) 178 156 179 ! control print (if less than 100 time-step asked) 180 IF( nitend-nit000 <= 100 .AND. lwp ) THEN 157 IF( nitend-nit000 <= 100 .AND. lwp ) THEN ! control print (if less than 100 time-step asked) 181 158 WRITE(numout,*) 182 159 WRITE(numout,*) ' read daily momentum, heat and freshwater fluxes OK' -
branches/dev_r2174_DCY/NEMO/OPA_SRC/SBC/sbcmod.F90
r2187 r2188 4 4 !! Surface module : provide to the ocean its surface boundary condition 5 5 !!====================================================================== 6 !! History : 3.0 ! 07-2006 (G. Madec) Original code 7 !! - ! 08-2008 (S. Masson, E. .... ) coupled interface 6 !! History : 3.0 ! 2006-07 (G. Madec) Original code 7 !! - ! 2008-08 (S. Masson, E. .... ) coupled interface 8 !! 3.3 ! 2010-10 (S. Masson) add diurnal cycle 8 9 !!---------------------------------------------------------------------- 9 10 … … 12 13 !! sbc : surface ocean momentum, heat and freshwater boundary conditions 13 14 !!---------------------------------------------------------------------- 14 USE oce ! ocean dynamics and tracers 15 USE dom_oce ! ocean space and time domain 16 USE phycst ! physical constants 17 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 USE sbc_ice ! Surface boundary condition: ice fields 20 USE sbcssm ! surface boundary condition: sea-surface mean variables 21 USE sbcana ! surface boundary condition: analytical formulation 22 USE sbcflx ! surface boundary condition: flux formulation 23 USE sbcblk_clio ! surface boundary condition: bulk formulation : CLIO 24 USE sbcblk_core ! surface boundary condition: bulk formulation : CORE 25 USE sbcice_if ! surface boundary condition: ice-if sea-ice model 26 USE sbcice_lim ! surface boundary condition: LIM 3.0 sea-ice model 27 USE sbcice_lim_2 ! surface boundary condition: LIM 2.0 sea-ice model 28 USE sbccpl ! surface boundary condition: coupled florulation 15 USE oce ! ocean dynamics and tracers 16 USE dom_oce ! ocean space and time domain 17 USE phycst ! physical constants 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 USE sbc_ice ! Surface boundary condition: ice fields 20 USE sbcssm ! surface boundary condition: sea-surface mean variables 21 USE sbcana ! surface boundary condition: analytical formulation 22 USE sbcflx ! surface boundary condition: flux formulation 23 USE sbcblk_clio ! surface boundary condition: bulk formulation : CLIO 24 USE sbcblk_core ! surface boundary condition: bulk formulation : CORE 25 USE sbcice_if ! surface boundary condition: ice-if sea-ice model 26 USE sbcice_lim ! surface boundary condition: LIM 3.0 sea-ice model 27 USE sbcice_lim_2 ! surface boundary condition: LIM 2.0 sea-ice model 28 USE sbccpl ! surface boundary condition: coupled florulation 29 29 USE cpl_oasis3, ONLY:lk_cpl ! are we in coupled mode? 30 USE sbcssr ! surface boundary condition: sea surface restoring31 USE sbcrnf ! surface boundary condition: runoffs32 USE sbcfwb ! surface boundary condition: freshwater budget33 USE closea ! closed sea34 35 USE prtctl ! Print control (prt_ctl routine)36 USE restart ! ocean restart37 USE iom 38 USE in_out_manager ! I/O manager30 USE sbcssr ! surface boundary condition: sea surface restoring 31 USE sbcrnf ! surface boundary condition: runoffs 32 USE sbcfwb ! surface boundary condition: freshwater budget 33 USE closea ! closed sea 34 35 USE prtctl ! Print control (prt_ctl routine) 36 USE restart ! ocean restart 37 USE iom ! IOM library 38 USE in_out_manager ! I/O manager 39 39 40 40 IMPLICIT NONE … … 49 49 # include "domzgr_substitute.h90" 50 50 !!---------------------------------------------------------------------- 51 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)51 !! NEMO/OPA 3.3 , NEMO-consortium (2010) 52 52 !! $Id$ 53 53 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 54 54 !!---------------------------------------------------------------------- 55 56 55 CONTAINS 57 56 … … 69 68 INTEGER :: icpt ! temporary integer 70 69 !! 71 NAMELIST/namsbc/ nn_fsbc, ln_ana , ln_flx, ln_blk_clio, ln_blk_core, ln_cpl, &72 & nn_ice , ln_dm2dc, ln_rnf, ln_ssr , nn_fwb, nn_ico_cpl70 NAMELIST/namsbc/ nn_fsbc, ln_ana , ln_flx, ln_blk_clio, ln_blk_core, ln_cpl , & 71 & nn_ice , ln_dm2dc, ln_rnf, ln_ssr , nn_fwb , nn_ico_cpl 73 72 !!---------------------------------------------------------------------- 74 73 … … 79 78 ENDIF 80 79 81 REWIND( numnam ) 80 REWIND( numnam ) ! Read Namelist namsbc 82 81 READ ( numnam, namsbc ) 83 82 84 ! overwrite namelist parameter using CPP key information 85 !!gm here no overwrite, test all option via namelist change: require more incore memory 86 !!gm IF( lk_sbc_cpl ) THEN ; ln_cpl = .TRUE. ; ELSE ; ln_cpl = .FALSE. ; ENDIF 87 88 IF ( Agrif_Root() ) THEN 89 IF( lk_lim2 ) nn_ice = 2 90 IF( lk_lim3 ) nn_ice = 3 91 ENDIF 92 ! 93 IF( cp_cfg == 'gyre' ) THEN 83 ! ! overwrite namelist parameter using CPP key information 84 IF( Agrif_Root() ) THEN ! AGRIF zoom 85 IF( lk_lim2 ) nn_ice = 2 86 IF( lk_lim3 ) nn_ice = 3 87 ENDIF 88 IF( cp_cfg == 'gyre' ) THEN ! GYRE configuration 94 89 ln_ana = .TRUE. 95 90 nn_ice = 0 96 91 ENDIF 97 92 98 ! Control print 99 IF(lwp) THEN 93 IF(lwp) THEN ! Control print 100 94 WRITE(numout,*) ' Namelist namsbc (partly overwritten with CPP key setting)' 101 95 WRITE(numout,*) ' frequency update of sbc (and ice) nn_fsbc = ', nn_fsbc … … 116 110 ENDIF 117 111 112 ! ! Checks: 118 113 IF( .NOT. ln_rnf ) THEN ! no specific treatment in vicinity of river mouths 119 114 ln_rnf_mouth = .false. … … 144 139 & CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 145 140 146 ! Choice of the Surface Boudary Condition (set nsbc)141 ! ! Choice of the Surface Boudary Condition (set nsbc) 147 142 icpt = 0 148 143 IF( ln_ana ) THEN ; nsbc = 1 ; icpt = icpt + 1 ; ENDIF ! analytical formulation … … 153 148 IF( cp_cfg == 'gyre') THEN ; nsbc = 0 ; ENDIF ! GYRE analytical formulation 154 149 IF( lk_esopa ) nsbc = -1 ! esopa test, ALL formulations 155 150 ! 156 151 IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN 157 152 WRITE(numout,*)
Note: See TracChangeset
for help on using the changeset viewer.
