- Timestamp:
- 2017-08-07T16:52:13+02:00 (7 years ago)
- Location:
- branches/UKMO/r6232_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 5 edited
-
SBC/sbcflx.F90 (modified) (7 diffs)
-
SBC/sbcssr.F90 (modified) (5 diffs)
-
TRA/trasbc.F90 (modified) (2 diffs)
-
step_oce.F90 (modified) (2 diffs)
-
trc_oce.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/r6232_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
r7454 r8408 28 28 PUBLIC sbc_flx ! routine called by step.F90 29 29 30 INTEGER , PARAMETER :: jpfld = 6! maximum number of files to read30 INTEGER , PARAMETER :: jpfld = 5 ! maximum number of files to read 31 31 INTEGER , PARAMETER :: jp_utau = 1 ! index of wind stress (i-component) file 32 32 INTEGER , PARAMETER :: jp_vtau = 2 ! index of wind stress (j-component) file … … 34 34 INTEGER , PARAMETER :: jp_qsr = 4 ! index of solar heat file 35 35 INTEGER , PARAMETER :: jp_emp = 5 ! index of evaporation-precipation file 36 INTEGER , PARAMETER :: jp_press = 6 ! index of pressure for UKMO shelf fluxes37 36 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) 38 LOGICAL , PUBLIC :: ln_shelf_flx = .FALSE. ! UKMO SHELF specific flux flag39 INTEGER :: jpfld_local ! maximum number of files to read (locally modified depending on ln_shelf_flx)40 37 41 38 !! * Substitutions … … 85 82 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 86 83 REAL(wp) :: ztx, zty, zmod, zcoef ! temporary variables 87 REAL :: cs ! UKMO SHELF: Friction co-efficient at surface88 REAL :: totwindspd ! UKMO SHELF: Magnitude of wind speed vector89 90 REAL(wp) :: rhoa = 1.22 ! Air density kg/m391 REAL(wp) :: cdrag = 1.5e-3 ! drag coefficient92 84 !! 93 85 CHARACTER(len=100) :: cn_dir ! Root directory for location of flx files 94 86 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist information structures 95 TYPE(FLD_N) :: sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp, sn_press ! informations about the fields to be read 96 LOGICAL :: ln_foam_flx = .FALSE. ! UKMO FOAM specific flux flag 97 NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp, & 98 & ln_foam_flx, sn_press, ln_shelf_flx 87 TYPE(FLD_N) :: sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp ! informations about the fields to be read 88 NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp 99 89 !!--------------------------------------------------------------------- 100 90 ! … … 119 109 slf_i(jp_emp ) = sn_emp 120 110 ! 121 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure 122 IF( ln_shelf_flx ) slf_i(jp_press) = sn_press 123 124 ! define local jpfld depending on shelf_flx logical 125 IF( ln_shelf_flx ) THEN 126 jpfld_local = jpfld 127 ELSE 128 jpfld_local = jpfld-1 129 ENDIF 130 ! 111 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure 131 112 IF( ierror > 0 ) THEN 132 113 CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN 133 114 ENDIF 134 DO ji= 1, jpfld _local115 DO ji= 1, jpfld 135 116 ALLOCATE( sf(ji)%fnow(jpi,jpj,1) ) 136 117 IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) … … 151 132 ENDIF 152 133 !CDIR COLLAPSE 153 !!UKMO SHELF effect of atmospheric pressure on SSH154 ! If using ln_apr_dyn, this is done there so don't repeat here.155 IF( ln_shelf_flx .AND. .NOT. ln_apr_dyn) THEN156 DO jj = 1, jpjm1157 DO ji = 1, jpim1158 apgu(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji+1,jj,1)-sf(jp_press)%fnow(ji,jj,1))/e1u(ji,jj)159 apgv(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji,jj+1,1)-sf(jp_press)%fnow(ji,jj,1))/e2v(ji,jj)160 END DO161 END DO162 ENDIF ! ln_shelf_flx163 164 134 DO jj = 1, jpj ! set the ocean fluxes from read fields 165 135 DO ji = 1, jpi 166 IF( ln_shelf_flx ) THEN 167 !! UKMO SHELF - need atmospheric pressure to calculate Haney forcing 168 pressnow(ji,jj) = sf(jp_press)%fnow(ji,jj,1) 169 !! UKMO SHELF flux files contain wind speed not wind stress 170 totwindspd = sqrt((sf(jp_utau)%fnow(ji,jj,1))**2.0 + (sf(jp_vtau)%fnow(ji,jj,1))**2.0) 171 cs = 0.63 + (0.066 * totwindspd) 172 utau(ji,jj) = cs * (rhoa/rau0) * sf(jp_utau)%fnow(ji,jj,1) * totwindspd 173 vtau(ji,jj) = cs * (rhoa/rau0) * sf(jp_vtau)%fnow(ji,jj,1) * totwindspd 174 ELSE 175 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 176 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 177 ENDIF 178 qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 179 IF( ln_foam_flx .OR. ln_shelf_flx ) THEN 180 !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot) 181 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) 182 !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P 183 emp (ji,jj) = -1. * sf(jp_emp )%fnow(ji,jj,1) 184 ELSE 185 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 186 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 187 ENDIF 136 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 137 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 138 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 139 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 188 140 END DO 189 141 END DO … … 191 143 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! mass flux is at SST 192 144 ! 193 194 !! UKMO FOAM wind fluxes need lbc_lnk calls owing to a bug in interp.exe195 IF( ln_foam_flx ) THEN196 CALL lbc_lnk( utau(:,:), 'U', -1. )197 CALL lbc_lnk( vtau(:,:), 'V', -1. )198 ENDIF199 200 145 ! ! module of wind stress and wind speed at T-point 201 146 zcoef = 1. / ( zrhoa * zcdrag ) … … 217 162 WRITE(numout,*) 218 163 WRITE(numout,*) ' read daily momentum, heat and freshwater fluxes OK' 219 DO jf = 1, jpfld _local164 DO jf = 1, jpfld 220 165 IF( jf == jp_utau .OR. jf == jp_vtau ) zfact = 1. 221 166 IF( jf == jp_qtot .OR. jf == jp_qsr ) zfact = 0.1 -
branches/UKMO/r6232_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r7454 r8408 42 42 LOGICAL :: ln_sssr_bnd ! flag to bound erp term 43 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 forcing45 44 46 45 REAL(wp) , ALLOCATABLE, DIMENSION(:) :: buffer ! Temporary buffer for exchange … … 80 79 INTEGER :: ierror ! return error code 81 80 !! 82 REAL(wp) :: sst1,sst2 ! sea surface temperature83 REAL(wp) :: e_sst1, e_sst2 ! saturation vapour pressure84 REAL(wp) :: qs1,qs2 ! specific humidity85 REAL(wp) :: pr_tmp ! temporary variable for pressure86 87 REAL(wp), DIMENSION(jpi,jpj) :: hny_frc1 ! Haney forcing for sensible heat, correction for latent heat88 REAL(wp), DIMENSION(jpi,jpj) :: hny_frc2 ! Haney forcing for sensible heat, correction for latent heat89 !!90 81 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 91 82 TYPE(FLD_N) :: sn_sst, sn_sss ! informations about the fields to be read … … 104 95 ! 105 96 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 123 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 131 END DO 132 END DO 133 ENDIF 97 DO jj = 1, jpj 98 DO ji = 1, jpi 99 zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 100 qns(ji,jj) = qns(ji,jj) + zqrp 101 qrp(ji,jj) = zqrp 102 END DO 103 END DO 134 104 CALL iom_put( "qrp", qrp ) ! heat flux damping 135 105 ENDIF … … 193 163 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 194 164 TYPE(FLD_N) :: sn_sst, sn_sss ! informations about the fields to be read 195 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_haney165 NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd 196 166 INTEGER :: ios 197 167 !!---------------------------------------------------------------------- … … 219 189 WRITE(numout,*) ' flag to bound erp term ln_sssr_bnd = ', ln_sssr_bnd 220 190 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_haney222 191 ENDIF 223 192 ! -
branches/UKMO/r6232_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r7452 r8408 25 25 USE trd_oce ! trends: ocean variables 26 26 USE trdtra ! trends manager: tracers 27 USE tradwl ! solar radiation penetration (downwell method)28 27 ! 29 28 USE in_out_manager ! I/O manager … … 139 138 140 139 !!gm IF( .NOT.ln_traqsr ) qsr(:,:) = 0.e0 ! no solar radiation penetration 141 IF( .NOT.ln_traqsr .and. .NOT.ln_tradwl) THEN ! no solar radiation penetration140 IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration 142 141 qns(:,:) = qns(:,:) + qsr(:,:) ! total heat flux in qns 143 142 qsr(:,:) = 0.e0 ! qsr set to zero -
branches/UKMO/r6232_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r7454 r8408 25 25 USE sbcrnf ! surface boundary condition: runoff variables 26 26 USE sbccpl ! surface boundary condition: coupled formulation (call send at end of step) 27 USE sbcflx ! surface boundary condition: Fluxes28 27 USE sbc_oce ! surface boundary condition: ocean 29 28 USE sbctide ! Tide initialisation … … 31 30 32 31 USE traqsr ! solar radiation penetration (tra_qsr routine) 33 USE tradwl ! POLCOMS style solar radiation (tra_dwl routine)34 32 USE trasbc ! surface boundary condition (tra_sbc routine) 35 33 USE trabbc ! bottom boundary condition (tra_bbc routine) -
branches/UKMO/r6232_CO6_CO5_zenv_pomsdwl/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
r7454 r8408 27 27 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: etot3 !: light absortion coefficient 28 28 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: facvol !: volume for degraded regions 29 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: rlambda2 !: Lambda2 for downwell version of Short wave Radiation30 REAL(wp), PUBLIC :: rlambda !: Lambda for downwell version of Short wave Radiation31 29 32 30 #if defined key_top … … 80 78 !! *** trc_oce_alloc *** 81 79 !!---------------------------------------------------------------------- 82 INTEGER :: ierr( 3) ! Local variables80 INTEGER :: ierr(2) ! Local variables 83 81 !!---------------------------------------------------------------------- 84 82 ierr(:) = 0 85 83 ALLOCATE( etot3 (jpi,jpj,jpk), STAT=ierr(1) ) 86 84 IF( lk_degrad) ALLOCATE( facvol(jpi,jpj,jpk), STAT=ierr(2) ) 87 ALLOCATE( rlambda2(jpi,jpj), STAT=ierr(3) )88 85 trc_oce_alloc = MAXVAL( ierr ) 89 86 ! 90 87 IF( trc_oce_alloc /= 0 ) CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array') 91 IF( trc_oce_alloc /= 0 ) CALL ctl_warn('trc_oce_alloc: failed to allocate etot3, facvol or rlambda2 array')92 88 END FUNCTION trc_oce_alloc 93 89
Note: See TracChangeset
for help on using the changeset viewer.
