Changeset 8141
- Timestamp:
- 2017-06-05T16:40:32+02:00 (8 years ago)
- Location:
- branches/UKMO/CO6_KD490_amm7_oper_fabm_chlrelax/NEMOGCM/NEMO/TOP_SRC/TRP
- Files:
-
- 2 edited
- 1 copied
-
trcnam_trp.F90 (modified) (4 diffs)
-
trcsbcssr.F90 (copied) (copied from branches/UKMO/CO6_KD490_amm7_oper_fabm_chlrelax/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90) (3 diffs)
-
trctrp.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/CO6_KD490_amm7_oper_fabm_chlrelax/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90
r6331 r8141 16 16 USE in_out_manager ! ocean dynamics and active tracers variables 17 17 USE lib_mpp ! distributed memory computing library 18 USE fldread 18 19 19 20 IMPLICIT NONE … … 52 53 INTEGER , PUBLIC :: nn_zdmp_tr ! = 0/1/2 flag for damping in the mixed layer 53 54 CHARACTER(LEN=200) , PUBLIC :: cn_resto_tr !File containing restoration coefficient 55 CHARACTER(LEN=200) , PUBLIC :: cn_dir_chldmp = './' !: Directory containing chlorophyll file 56 INTEGER , PUBLIC :: nn_chldmp = 0 !: = 0/1/2 flag for surface chlorophyll damping 57 REAL(wp), PUBLIC :: rn_chldmp = 0.0 !: chlorophyll damping coefficient 58 TYPE(FLD_N), PUBLIC :: sn_chldmp !: informations about the fields to be read 54 59 55 60 !!---------------------------------------------------------------------- … … 77 82 NAMELIST/namtrc_zdf/ ln_trczdf_exp , nn_trczdf_exp 78 83 NAMELIST/namtrc_rad/ ln_trcrad 79 NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr 84 NAMELIST/namtrc_dmp/ nn_zdmp_tr , cn_resto_tr, cn_dir_chldmp, nn_chldmp, & 85 & sn_chldmp , rn_chldmp 80 86 !!---------------------------------------------------------------------- 81 87 … … 179 185 WRITE(numout,*) ' mixed layer damping option nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)' 180 186 WRITE(numout,*) ' Restoration coeff file cn_resto_tr = ', cn_resto_tr 187 WRITE(numout,*) ' Surface chlorophyll damping nn_chldmp = ', nn_chldmp 188 WRITE(numout,*) ' Damping coefficient rn_chldmp = ', rn_chldmp 189 WRITE(numout,*) ' Chlorophyll directory cn_dir_chldmp = ', cn_dir_chldmp 181 190 ENDIF 182 191 ! -
branches/UKMO/CO6_KD490_amm7_oper_fabm_chlrelax/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbcssr.F90
r8110 r8141 1 MODULE sbcssr1 MODULE trcsbcssr 2 2 !!====================================================================== 3 !! *** MODULE sbcssr ***4 !! Surface module : heat and fresh water fluxes a restoring term toward observed SST/SSS3 !! *** MODULE trcsbcssr *** 4 !! Surface module : restoring term towards surface chlorophyll climatology 5 5 !!====================================================================== 6 !! History : 3.0 ! 2006-06 (G. Madec) Original code 7 !! 3.2 ! 2009-04 (B. Lemaire) Introduce iom_put 6 !! History : 3.6 ! 2017-06 (D. Ford) Adapt from sbcssr.F90 8 7 !!---------------------------------------------------------------------- 9 8 #if defined key_top 10 9 !!---------------------------------------------------------------------- 11 !! sbc_ssr : add to sbc a restoring term toward SST/SSSclimatology12 !! sbc_ssr_init : initialisation of surface restoring10 !! trc_sbc_ssr : add a restoring term toward chl climatology 11 !! trc_sbc_ssr_init : initialisation of surface restoring 13 12 !!---------------------------------------------------------------------- 14 USE oce ! ocean dynamics and tracers15 13 USE dom_oce ! ocean space and time domain 16 USE sbc_oce ! surface boundary condition17 USE phycst ! physical constants18 USE sbcrnf ! surface boundary condition : runoffs14 USE oce_trc ! shared variables between ocean and passive tracers 15 USE trc 16 USE trcnam_trp 19 17 ! 20 18 USE fldread ! read input fields … … 25 23 USE timing ! Timing 26 24 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 25 #if defined key_fabm 26 USE par_fabm 27 #endif 27 28 28 29 IMPLICIT NONE 29 30 PRIVATE 30 31 31 PUBLIC sbc_ssr ! routine called in sbcmod 32 PUBLIC sbc_ssr_init ! routine called in sbcmod 32 PUBLIC trc_sbc_ssr ! routine called in trctrp 33 33 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: erp !: evaporation damping [kg/m2/s] 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qrp !: heat flux damping [w/m2] 36 37 ! !!* Namelist namsbc_ssr * 38 INTEGER, PUBLIC :: nn_sstr ! SST/SSS restoring indicator 39 INTEGER, PUBLIC :: nn_sssr ! SST/SSS restoring indicator 40 REAL(wp) :: rn_dqdt ! restoring factor on SST and SSS 41 REAL(wp) :: rn_deds ! restoring factor on SST and SSS 42 LOGICAL :: ln_sssr_bnd ! flag to bound erp term 43 REAL(wp) :: rn_sssr_bnd ! ABS(Max./Min.) value of erp term [mm/day] 44 LOGICAL :: ln_UKMO_haney ! UKMO specific flag to calculate Haney forcing 45 46 REAL(wp) , ALLOCATABLE, DIMENSION(:) :: buffer ! Temporary buffer for exchange 47 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sst ! structure of input SST (file informations, fields read) 48 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sss ! structure of input SSS (file informations, fields read) 34 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_chldmp ! structure of input Chl (file informations, fields read) 49 35 50 36 !! * Substitutions 51 # include "domzgr_substitute.h90" 52 !!---------------------------------------------------------------------- 53 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 54 !! $Id$ 55 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 56 !!---------------------------------------------------------------------- 37 # include "top_substitute.h90" 38 57 39 CONTAINS 58 40 59 SUBROUTINE sbc_ssr( kt )41 SUBROUTINE trc_sbc_ssr( kt ) 60 42 !!--------------------------------------------------------------------- 61 !! *** ROUTINE sbc_ssr ***43 !! *** ROUTINE trc_sbc_ssr *** 62 44 !! 63 !! ** Purpose : Add to heat and/or freshwater fluxesa damping term64 !! toward observed SST and/or SSS.45 !! ** Purpose : Add to chlorophyll a damping term 46 !! toward chlorophyll climatology 65 47 !! 66 !! ** Method : - Read namelist namsbc_ssr 67 !! - Read observed SST and/or SSS 68 !! - at each nscb time step 69 !! add a retroaction term on qns (nn_sstr = 1) 70 !! add a damping term on sfx (nn_sssr = 1) 71 !! add a damping term on emp (nn_sssr = 2) 48 !! ** Method : - Read chlorophyll climatology 49 !! - at each trc time step add term to each PFT 50 !! surface only (nn_chldmp = 1) 51 !! mixed layer (nn_chldmp = 2) 72 52 !!--------------------------------------------------------------------- 73 53 INTEGER, INTENT(in ) :: kt ! ocean time step 74 54 !! 75 INTEGER :: ji, jj ! dummy loop indices 76 REAL(wp) :: zerp ! local scalar for evaporation damping 77 REAL(wp) :: zqrp ! local scalar for heat flux damping 78 REAL(wp) :: zsrp ! local scalar for unit conversion of rn_deds factor 79 REAL(wp) :: zerp_bnd ! local scalar for unit conversion of rn_epr_max factor 80 INTEGER :: ierror ! return error code 81 !! 82 REAL(wp) :: sst1,sst2 ! sea surface temperature 83 REAL(wp) :: e_sst1, e_sst2 ! saturation vapour pressure 84 REAL(wp) :: qs1,qs2 ! specific humidity 85 REAL(wp) :: pr_tmp ! temporary variable for pressure 55 INTEGER :: ji, jj, jk ! dummy loop indices 86 56 87 REAL(wp), DIMENSION(jpi,jpj) :: hny_frc1 ! Haney forcing for sensible heat, correction for latent heat 88 REAL(wp), DIMENSION(jpi,jpj) :: hny_frc2 ! Haney forcing for sensible heat, correction for latent heat 89 !! 90 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 91 TYPE(FLD_N) :: sn_sst, sn_sss ! informations about the fields to be read 57 REAL(wp), DIMENSION(jpi,jpj) :: ztra, zchl 58 REAL(wp) :: zpft 92 59 !!---------------------------------------------------------------------- 93 60 ! 94 IF( nn_timing == 1 ) CALL timing_start(' sbc_ssr')61 IF( nn_timing == 1 ) CALL timing_start('trc_sbc_ssr') 95 62 ! 96 IF( nn_sstr + nn_sssr /= 0 )THEN63 IF( kt == nittrc000 ) THEN 97 64 ! 98 IF( nn_sstr == 1) CALL fld_read( kt, nn_fsbc, sf_sst ) ! Read SST data and provides it at kt 99 IF( nn_sssr >= 1) CALL fld_read( kt, nn_fsbc, sf_sss ) ! Read SSS data and provides it at kt 65 CALL trc_sbc_ssr_init 100 66 ! 101 ! ! ========================= ! 102 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Add restoring term ! 103 ! ! ========================= ! 67 IF( nn_chldmp > 0 ) THEN 104 68 ! 105 IF( nn_sstr == 1 ) THEN !* Temperature restoring term 106 IF( ln_UKMO_haney ) THEN 107 DO jj = 1, jpj 108 DO ji = 1, jpi 109 sst1 = sst_m(ji,jj) 110 sst2 = sf_sst(1)%fnow(ji,jj,1) 111 e_sst1 = 10**((0.7859+0.03477*sst1)/(1.+0.00412*sst1)) 112 e_sst2 = 10**((0.7859+0.03477*sst2)/(1.+0.00412*sst2)) 113 pr_tmp = 0.01*pressnow(ji,jj) !pr_tmp = 1012.0 114 qs1 = (0.62197*e_sst1)/(pr_tmp-0.378*e_sst1) 115 qs2 = (0.62197*e_sst2)/(pr_tmp-0.378*e_sst2) 116 hny_frc1(ji,jj) = sst1-sst2 117 hny_frc2(ji,jj) = qs1-qs2 118 !Might need to mask off land points. 119 hny_frc1(ji,jj)=-hny_frc1(ji,jj)*wndm(ji,jj)*1.42 120 hny_frc2(ji,jj)=-hny_frc2(ji,jj)*wndm(ji,jj)*4688.0 121 qns(ji,jj)=qns(ji,jj)+hny_frc1(ji,jj)+hny_frc2(ji,jj) 122 qrp(ji,jj) = 0.e0 69 IF (lwp) WRITE(numout,*) 'Damping chlorophyll on timestep ', kt 70 ! 71 CALL fld_read( kt, 1, sf_chldmp ) ! Read Chl data and provides it at kt 72 ! 73 #if defined key_fabm 74 zchl(:,:) = trb(:,:,1,jp_fabm_m1+jp_fabm_chl1) + & 75 & trb(:,:,1,jp_fabm_m1+jp_fabm_chl2) + & 76 & trb(:,:,1,jp_fabm_m1+jp_fabm_chl3) + & 77 & trb(:,:,1,jp_fabm_m1+jp_fabm_chl4) 78 ztra(:,:) = rn_chldmp * ( sf_chldmp(1)%fnow(:,:,1) - zchl(:,:) ) 79 ! 80 DO jj = 2, jpjm1 81 DO ji = fs_2, fs_jpim1 ! vector opt. 82 IF ( ( sf_chldmp(1)%fnow(ji,jj,1) > 0.0 ) .AND. & 83 & ( sf_chldmp(1)%fnow(ji,jj,1) < 100.0 ) .AND. & 84 & ( zchl(ji,jj) > 0.0 ) ) THEN 85 WRITE(numout,'(A,3I,3F)') 'ssr, nproc, ji, jj, zchl, sf, ztra = ', nproc, ji, jj, zchl(ji,jj), sf_chldmp(1)%fnow(ji,jj,1), ztra(ji,jj) 86 zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) / zchl(ji,jj) ) * ztra(ji,jj) 87 tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) + zpft 88 WRITE(numout,'(A,3I,2F)') 'ssr, nproc, ji, jj, trb1, zpft1 = ', nproc, ji, jj, trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl1), zpft 89 IF( nn_chldmp == 2 ) THEN 90 DO jk = 2, jpkm1 91 IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN 92 tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) + zpft 93 ENDIF 123 94 END DO 124 END DO 125 ELSE 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 129 qns(ji,jj) = qns(ji,jj) + zqrp 130 qrp(ji,jj) = zqrp 95 ENDIF 96 ! 97 zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) / zchl(ji,jj) ) * ztra(ji,jj) 98 tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) + zpft 99 WRITE(numout,'(A,3I,2F)') 'ssr, nproc, ji, jj, trb2, zpft2 = ', nproc, ji, jj, trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl2), zpft 100 IF( nn_chldmp == 2 ) THEN 101 DO jk = 2, jpkm1 102 IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN 103 tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2) + zpft 104 ENDIF 131 105 END DO 132 END DO 106 ENDIF 107 ! 108 zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) / zchl(ji,jj) ) * ztra(ji,jj) 109 tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) + zpft 110 WRITE(numout,'(A,3I,2F)') 'ssr, nproc, ji, jj, trb3, zpft3 = ', nproc, ji, jj, trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl3), zpft 111 IF( nn_chldmp == 2 ) THEN 112 DO jk = 2, jpkm1 113 IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN 114 tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3) + zpft 115 ENDIF 116 END DO 117 ENDIF 118 ! 119 zpft = ( trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) / zchl(ji,jj) ) * ztra(ji,jj) 120 tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) = tra(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) + zpft 121 WRITE(numout,'(A,3I,2F)') 'ssr, nproc, ji, jj, trb4, zpft4 = ', nproc, ji, jj, trb(ji,jj,1,jp_fabm_m1+jp_fabm_chl4), zpft 122 IF( nn_chldmp == 2 ) THEN 123 DO jk = 2, jpkm1 124 IF( fsdept(ji,jj,jk) < hmlp (ji,jj) ) THEN 125 tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4) = tra(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4) + zpft 126 ENDIF 127 END DO 128 ENDIF 133 129 ENDIF 134 CALL iom_put( "qrp", qrp ) ! heat flux damping135 ENDIF136 !137 IF( nn_sssr == 1 ) THEN !* Salinity damping term (salt flux only (sfx))138 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s]139 !CDIR COLLAPSE140 DO jj = 1, jpj141 DO ji = 1, jpi142 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths143 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )144 sfx(ji,jj) = sfx(ji,jj) + zerp ! salt flux145 erp(ji,jj) = zerp / MAX( sss_m(ji,jj), 1.e-20 ) ! converted into an equivalent volume flux (diagnostic only)146 END DO147 130 END DO 148 CALL iom_put( "erp", erp ) ! freshwater flux damping 149 ! 150 ELSEIF( nn_sssr == 2 ) THEN !* Salinity damping term (volume flux (emp) and associated heat flux (qns) 151 zsrp = rn_deds / rday ! from [mm/day] to [kg/m2/s] 152 zerp_bnd = rn_sssr_bnd / rday ! - - 153 !CDIR COLLAPSE 154 DO jj = 1, jpj 155 DO ji = 1, jpi 156 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 157 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) & 158 & / MAX( sss_m(ji,jj), 1.e-20 ) 159 IF( ln_sssr_bnd ) zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) ) 160 emp(ji,jj) = emp (ji,jj) + zerp 161 qns(ji,jj) = qns(ji,jj) - zerp * rcp * sst_m(ji,jj) 162 erp(ji,jj) = zerp 163 END DO 164 END DO 165 CALL iom_put( "erp", erp ) ! freshwater flux damping 166 ENDIF 131 END DO 132 #else 133 CALL ctl_stop( 'STOP', 'trc_sbc_ssr: only works with FABM-ERSEM' ) 134 #endif 167 135 ! 168 136 ENDIF … … 170 138 ENDIF 171 139 ! 172 IF( nn_timing == 1 ) CALL timing_stop(' sbc_ssr')140 IF( nn_timing == 1 ) CALL timing_stop('trc_sbc_ssr') 173 141 ! 174 END SUBROUTINE sbc_ssr142 END SUBROUTINE trc_sbc_ssr 175 143 176 144 177 SUBROUTINE sbc_ssr_init145 SUBROUTINE trc_sbc_ssr_init 178 146 !!--------------------------------------------------------------------- 179 !! *** ROUTINE sbc_ssr_init ***147 !! *** ROUTINE trc_sbc_ssr_init *** 180 148 !! 181 149 !! ** Purpose : initialisation of surface damping term 182 150 !! 183 !! ** Method : - Read namelist namsbc_ssr 184 !! - Read observed SST and/or SSS if required 151 !! ** Method : - Read chlorophyll 185 152 !!--------------------------------------------------------------------- 186 INTEGER :: ji, jj ! dummy loop indices187 REAL(wp) :: zerp ! local scalar for evaporation damping188 REAL(wp) :: zqrp ! local scalar for heat flux damping189 REAL(wp) :: zsrp ! local scalar for unit conversion of rn_deds factor190 REAL(wp) :: zerp_bnd ! local scalar for unit conversion of rn_epr_max factor191 153 INTEGER :: ierror ! return error code 192 !!193 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files194 TYPE(FLD_N) :: sn_sst, sn_sss ! informations about the fields to be read195 NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd, ln_UKMO_haney196 INTEGER :: ios197 154 !!---------------------------------------------------------------------- 198 155 ! 199 200 REWIND( numnam_ref ) ! Namelist namsbc_ssr in reference namelist : 201 READ ( numnam_ref, namsbc_ssr, IOSTAT = ios, ERR = 901) 202 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in reference namelist', lwp ) 203 204 REWIND( numnam_cfg ) ! Namelist namsbc_ssr in configuration namelist : 205 READ ( numnam_cfg, namsbc_ssr, IOSTAT = ios, ERR = 902 ) 206 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in configuration namelist', lwp ) 207 IF(lwm) WRITE ( numond, namsbc_ssr ) 208 209 IF(lwp) THEN !* control print 210 WRITE(numout,*) 211 WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term ' 212 WRITE(numout,*) '~~~~~~~ ' 213 WRITE(numout,*) ' Namelist namsbc_ssr :' 214 WRITE(numout,*) ' SST restoring term (Yes=1) nn_sstr = ', nn_sstr 215 WRITE(numout,*) ' SSS damping term (Yes=1, salt flux) nn_sssr = ', nn_sssr 216 WRITE(numout,*) ' (Yes=2, volume flux) ' 217 WRITE(numout,*) ' dQ/dT (restoring magnitude on SST) rn_dqdt = ', rn_dqdt, ' W/m2/K' 218 WRITE(numout,*) ' dE/dS (restoring magnitude on SST) rn_deds = ', rn_deds, ' mm/day' 219 WRITE(numout,*) ' flag to bound erp term ln_sssr_bnd = ', ln_sssr_bnd 220 WRITE(numout,*) ' ABS(Max./Min.) erp threshold rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 221 WRITE(numout,*) ' Haney forcing ln_UKMO_haney = ', ln_UKMO_haney 222 ENDIF 223 ! 224 ! !* Allocate erp and qrp array 225 ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror ) 226 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' ) 227 ! 228 IF( nn_sstr == 1 ) THEN !* set sf_sst structure & allocate arrays 156 IF( nn_chldmp > 0 ) THEN !* set sf_sss structure & allocate arrays 229 157 ! 230 ALLOCATE( sf_ sst(1), STAT=ierror )231 IF( ierror > 0 ) CALL ctl_stop( 'STOP', ' sbc_ssr: unable to allocate sf_sststructure' )232 ALLOCATE( sf_ sst(1)%fnow(jpi,jpj,1), STAT=ierror )233 IF( ierror > 0 ) CALL ctl_stop( 'STOP', ' sbc_ssr: unable to allocate sf_sstnow array' )158 ALLOCATE( sf_chldmp(1), STAT=ierror ) 159 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'trc_sbc_ssr: unable to allocate sf_chldmp structure' ) 160 ALLOCATE( sf_chldmp(1)%fnow(jpi,jpj,1), STAT=ierror ) 161 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'trc_sbc_ssr: unable to allocate sf_chldmp now array' ) 234 162 ! 235 ! fill sf_ss t with sn_sstand control print236 CALL fld_fill( sf_ sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' )237 IF( sf_ sst(1)%ln_tint ) ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2), STAT=ierror )238 IF( ierror > 0 ) CALL ctl_stop( 'STOP', ' sbc_ssr: unable to allocate sf_sstdata array' )163 ! fill sf_sss with sn_sss and control print 164 CALL fld_fill( sf_chldmp, (/ sn_chldmp /), cn_dir_chldmp, 'trc_sbc_ssr', 'Chl restoring term', 'namtrc_dmp' ) 165 IF( sf_chldmp(1)%ln_tint ) ALLOCATE( sf_chldmp(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 166 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'trc_sbc_ssr: unable to allocate sf_chldmp data array' ) 239 167 ! 240 168 ENDIF 241 169 ! 242 IF( nn_sssr >= 1 ) THEN !* set sf_sss structure & allocate arrays 243 ! 244 ALLOCATE( sf_sss(1), STAT=ierror ) 245 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss structure' ) 246 ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1), STAT=ierror ) 247 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss now array' ) 248 ! 249 ! fill sf_sss with sn_sss and control print 250 CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' ) 251 IF( sf_sss(1)%ln_tint ) ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 252 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss data array' ) 253 ! 254 ENDIF 255 ! 256 ! !* Initialize qrp and erp if no restoring 257 IF( nn_sstr /= 1 ) qrp(:,:) = 0._wp 258 IF( nn_sssr /= 1 .OR. nn_sssr /= 2 ) erp(:,:) = 0._wp 259 ! 260 END SUBROUTINE sbc_ssr_init 261 170 END SUBROUTINE trc_sbc_ssr_init 171 172 #else 173 SUBROUTINE trc_sbc_ssr( kt ) ! Empty routine 174 INTEGER, INTENT(in) :: kt 175 WRITE(*,*) 'trc_sbc_ssr: You should not have seen this print! error?', kt 176 END SUBROUTINE trc_sbc_ssr 177 #endif 262 178 !!====================================================================== 263 END MODULE sbcssr179 END MODULE trcsbcssr -
branches/UKMO/CO6_KD490_amm7_oper_fabm_chlrelax/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r6332 r8141 29 29 USE trcbdy ! BDY open boundaries 30 30 USE bdy_par, only: lk_bdy 31 USE trcsbcssr 31 32 32 33 #if defined key_agrif … … 66 67 IF( .NOT. lk_c1d ) THEN 67 68 ! 69 IF( nn_chldmp > 0 ) CALL trc_sbc_ssr( kstp ) ! add Chl damping term 68 70 CALL trc_sbc( kstp ) ! surface boundary condition 69 71 IF( lk_trabbl ) CALL trc_bbl( kstp ) ! advective (and/or diffusive) bottom boundary layer scheme … … 93 95 ! 94 96 ELSE ! 1D vertical configuration 97 IF( nn_chldmp > 0 ) CALL trc_sbc_ssr( kstp ) ! add Chl damping term 95 98 CALL trc_sbc( kstp ) ! surface boundary condition 96 99 IF( .NOT. lk_offline .AND. lk_zdfkpp ) &
Note: See TracChangeset
for help on using the changeset viewer.
