New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
tradwl.F90 in NEMO/branches/UKMO/NEMO_4.0.4_CO9_shelf_climate/src/OCE/TRA – NEMO

source: NEMO/branches/UKMO/NEMO_4.0.4_CO9_shelf_climate/src/OCE/TRA/tradwl.F90 @ 15608

Last change on this file since 15608 was 15445, checked in by hadjt, 3 years ago

TRA/tradwl.F90

Bug fix... used tmask(0,:,:) rather than tmask(1,:,:) this assumed everywhere was land. The radiation then penetrated too deep, and so the surface water as too cold.
File size: 10.4 KB
Line 
1MODULE tradwl
2   !!======================================================================
3   !!                       ***  MODULE  tradwl  ***
4   !! Ocean physics: solar radiation penetration in the top ocean levels
5   !!======================================================================
6   !! History :  POLCOMS  !  1996-10  (J. Holt)  Original code
7   !!   NEMO     3.2  !  2010-03  (E. O'Dea)  Import to Nemo for use in Shelf Model
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   tra_dwl      : trend due to the solar radiation penetration
12   !!   tra_dwl_init : solar radiation penetration initialization
13   !!----------------------------------------------------------------------
14   USE oce             ! ocean dynamics and active tracers
15   USE dom_oce         ! ocean space and time domain
16   USE sbc_oce         ! surface boundary condition: ocean
17   USE trc_oce         ! share SMS/Ocean variables
18   USE trd_oce         ! trends: ocean variables
19   USE trdtra          ! ocean active tracers trends
20   USE in_out_manager  ! I/O manager
21   USE phycst          ! physical constants
22   USE prtctl          ! Print control
23   USE iom             ! I/O manager
24   USE fldread         ! read input fields
25   !JT
26   USE domzgr
27   USE domain
28   !JT
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   tra_dwl        ! routine called by step.F90 (ln_tradwl=T)
33
34   !                                           !!* Namelist namtra_qsr: penetrative solar radiation
35   LOGICAL , PUBLIC ::   ln_tradwl  = .TRUE.    ! light absorption (dwl) flag
36   LOGICAL , PUBLIC ::   ln_vary_lambda  = .TRUE.    ! vary Lambda or not flag
37   
38   !! * Substitutions
39!#  include "domzgr_substitute.h90"
40#  include "vectopt_loop_substitute.h90"
41   !!----------------------------------------------------------------------
42   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
43   !! $Id$
44   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
45   !!----------------------------------------------------------------------
46
47CONTAINS
48
49   SUBROUTINE tra_dwl( kt )
50      !!----------------------------------------------------------------------
51      !!                  ***  ROUTINE tra_qsr  ***
52      !!
53      !! ** Purpose :   Compute the temperature trend due to the solar radiation
54      !!      penetration and add it to the general temperature trend.
55      !!
56      !! ** Method  : The profile of the solar radiation within the ocean is defined
57      !!
58      !!          Jason Holt Oct 96
59      !!
60      !!          Calculates change in temperature due to penetrating
61      !!          radiation, with cooling at the surface layer
62      !!
63      !!          rad=rad0*exp(lambda*z)
64      !!
65      !!       Heat input into box is between z=K and z=K+1 is RAD(K)-RAD(K+1)
66      !!
67      !!
68      !! ** Action  : - update ta with the penetrative solar radiation trend
69      !!              - save the trend in ttrd ('key_trdtra')
70      !!
71      !!----------------------------------------------------------------------
72      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace   
73      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace   
74      !!
75      INTEGER, INTENT(in) ::   kt     ! ocean time-step
76      !!
77      INTEGER  ::   ji, jj, jk           ! dummy loop indices
78      INTEGER  ::   irgb                 ! temporary integers
79      REAL(wp) ::   zchl, zcoef, zsi0r   ! temporary scalars
80      REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         -
81      !JT
82      REAL(wp), DIMENSION(jpi,jpj) ::   hbatt, qsr_tradwl
83      !JT
84      !!----------------------------------------------------------------------
85      !! HERE GO VARIABLES USED IN POLCOMS CLEAN UP LATER
86
87      integer i,j,k
88!      real*8 dtmp(n-1)
89      real*8 dtmp(jpkm1)
90      real*8 z1,z2,Rad0,Rad1,Rad2,rD,SurfOut,cp
91      logical first
92      save first
93      data first/.true./
94      !!--------------------------End of POLCOMS variables Note instead of using saves
95      !!--------------------------Could shift this into initial code
96
97      IF( kt == nit000 ) THEN
98         IF(lwp) WRITE(numout,*)
99         IF(lwp) WRITE(numout,*) 'tra_dwl : penetration of the surface solar radiation'
100         IF(lwp) WRITE(numout,*) '~~~~~~~'
101         CALL tra_dwl_init
102         IF( .NOT.ln_tradwl )   RETURN
103      ENDIF
104
105      IF( l_trdtra ) THEN      ! Save ta and sa trends
106         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
107         ztrds(:,:,:) = 0.e0
108      ENDIF
109!--------------------------------------------------------------------
110!  Set transmissivity
111!--------------------------------------------------------------------
112!
113!  Normal value
114!
115!---------------------------------------------------------------------------
116!
117!  Convert Heat fluxes to units used in POL subroutine dwl
118!
119!---------------------------------------------------------------------------
120    !cp=3986.0d0
121
122    DO jj = 2, jpj
123         DO ji = fs_2, fs_jpim1
124           qsr_tradwl(ji,jj)  = qsr(ji,jj)  * (r1_rau0_rcp)
125         ENDDO       !ji
126    ENDDO            !jj
127!--------------------------------------------------------------------------------
128 
129
130   if ( first ) then
131    do jj=2,jpjm1
132      do ji = fs_2, fs_jpim1 
133          IF ( tmask(ji,jj,1) .EQ. 1) THEN ! if land
134            hbatt(ji,jj) = sum( e3t_n(ji,jj,:)*tmask(ji,jj,:) )
135        else
136            hbatt(ji,jj)= 0.
137        endif
138      enddo ! ji
139    enddo ! jj
140
141   !CALL iom_put('hbatt_tradwl', hbatt(:,:) )
142
143        rlambda2(:,:) = 0.0
144        first=.false.
145        if ( ln_vary_lambda ) then
146
147        do jj=2,jpjm1
148          do ji = fs_2, fs_jpim1   ! vector opt.
149              !IF ( tmask(ji,jj,1) .EQ. 1) THEN ! if land
150
151
152              rlambda2(ji,jj)=-0.033*log(hbatt(ji,jj))+0.2583    ! JIAs formula
153              rlambda2(ji,jj)=max(0.05,rlambda2(ji,jj))     ! limit in deep water
154              rlambda2(ji,jj)=min(0.25,rlambda2(ji,jj))     ! Catch the infinities, from very shallow water/land. 10cm = 0.25
155
156            !else
157            !    rlambda2(ji,jj)= 0.25
158            !endif
159          enddo ! ji
160        enddo ! jj
161        rlambda = 0.0
162       else
163        rLambda=0.154
164       endif ! If vary lambda
165      endif ! If first
166
167      ! CALL iom_put('rlambda2_tradwl', rlambda2(:,:) )
168
169      DO jk=2,jpk
170         DO jj=2,jpjm1
171            DO ji = fs_2, fs_jpim1   ! vector opt.
172
173              IF ( tmask(ji,jj,1) .EQ. 1) THEN ! if land
174
175    !--------------------------------------------------------------------
176    ! Calculate change in temperature
177    !--------------------------------------------------------------------
178    !
179    !        rad0 = hfl_in(i,j)   ! change hfl_in to qsr I assume
180
181                    rad0 = qsr_tradwl(ji,jj)
182                    rD = rLambda2(ji,jj)  +rLambda      !  Transmissivity to be used here
183                          !       if rlambda 0 then rlambda2 not zer and vica versa
184
185                    z2=gdepw_0(ji,jj,jk-1)    ! grid box is from z=z1 to z=z2
186                    z1=gdepw_0(ji,jj,jk)
187
188                    Rad2=Rad0*(exp(-z2*rD)) ! radiation entering box
189                    Rad1=Rad0*(exp(-z1*rD)) ! radiation leaving box
190
191
192                    dtmp(jk)=1.0/(e3t_0(ji,jj,jk))*(Rad2-Rad1) !change in temperature
193                    tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + dtmp(jk)
194                endif ! if land
195            enddo  ! ji
196         enddo  ! jj
197      enddo !jk
198
199
200      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics
201         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
202         !CEODCALL trd_mod( ztrdt, ztrds, jptra_trd_qsr, 'TRA', kt )
203      ENDIF
204      !                       ! print mean trends (used for debugging)
205      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
206      !
207   END SUBROUTINE tra_dwl
208
209
210   SUBROUTINE tra_dwl_init
211      !!----------------------------------------------------------------------
212      !!                  ***  ROUTINE tra_dwl_init  ***
213      !!
214      !! ** Purpose :   Initialization for the penetrative solar radiation for Downwell routine
215      !!
216      !! ** Method  :   The profile of solar radiation within the ocean is set
217      !!      from two length scale of penetration (rn_si0,rn_si1) and a ratio
218      !!      (rn_abs). These parameters are read in the namtra_qsr namelist. The
219      !!      default values correspond to clear water (type I in Jerlov'
220      !!      (1968) classification.
221      !!         called by tra_qsr at the first timestep (nit000)
222      !!
223      !! ** Action  : - initialize rn_si0, rn_si1 and rn_abs
224      !!
225      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
226      !!----------------------------------------------------------------------
227      INTEGER  ::   ji, jj, jk            ! dummy loop indices
228      INTEGER  ::   ios                   ! Local integer output status for namelist read
229      INTEGER  ::   irgb, ierror          ! temporary integer
230      INTEGER  ::   ioptio, nqsr          ! temporary integer
231      REAL(wp) ::   zc0  , zc1            ! temporary scalars
232      REAL(wp) ::   zc2  , zc3  , zchl    !    -         -
233      REAL(wp) ::   zsi0r, zsi1r, zcoef   !    -         -
234      !!
235      CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files
236      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read
237      NAMELIST/namtra_dwl/  ln_tradwl, ln_vary_lambda
238      !!----------------------------------------------------------------------
239
240      REWIND( numnam_ref )            ! Read Namelist namtra_dwl in reference namelist :
241      READ  ( numnam_ref, namtra_dwl, IOSTAT = ios, ERR = 901)
242901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_qsr in reference namelist')
243     
244      REWIND( numnam_cfg )            ! Read Namelist namtra_dwl in configuration namelist :
245      READ  ( numnam_cfg, namtra_dwl, IOSTAT = ios, ERR = 902)
246902   IF( ios > 0 ) CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist')
247      !
248      IF(lwp) THEN                ! control print
249         WRITE(numout,*)
250         WRITE(numout,*) 'tra_dwl_init : '
251         WRITE(numout,*) '~~~~~~~~~~~~'
252         WRITE(numout,*) '   Namelist namtra_dwl : set the parameter of penetration'
253         WRITE(numout,*) '      Light penetration (T) or not (F)         ln_tradwl  = ', ln_tradwl
254         WRITE(numout,*) '      Vary Lambda  (T) or not (F))             ln_vary_lambda  = ', ln_vary_lambda
255      ENDIF
256
257   END SUBROUTINE tra_dwl_init
258
259   !!======================================================================
260END MODULE tradwl
Note: See TracBrowser for help on using the repository browser.