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 @ 15318

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

Update tradwl.F90 to switch developmental print statements
File size: 11.7 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) ::   hbatt
83      !JT
84      REAL(wp), DIMENSION(jpi,jpj)     ::   zekb, zekg, zekr            ! 2D workspace
85      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze0, ze1 , ze2, ze3, zea    ! 3D workspace
86      !!----------------------------------------------------------------------
87      !! HERE GO VARIABLES USED IN POLCOMS CLEAN UP LATER
88
89      integer i,j,k
90!      real*8 dtmp(n-1)
91      real*8 dtmp(jpkm1)
92      real*8 z1,z2,Rad0,Rad1,Rad2,rD,SurfOut,cp
93      logical first
94      save first
95      data first/.true./
96      !!--------------------------End of POLCOMS variables Note instead of using saves
97      !!--------------------------Could shift this into initial code
98
99      IF( kt == nit000 ) THEN
100         IF(lwp) WRITE(numout,*)
101         IF(lwp) WRITE(numout,*) 'tra_dwl : penetration of the surface solar radiation'
102         IF(lwp) WRITE(numout,*) '~~~~~~~'
103         CALL tra_dwl_init
104         IF( .NOT.ln_tradwl )   RETURN
105      ENDIF
106
107      IF( l_trdtra ) THEN      ! Save ta and sa trends
108         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
109         ztrds(:,:,:) = 0.e0
110      ENDIF
111!--------------------------------------------------------------------
112!  Set transmissivity
113!--------------------------------------------------------------------
114!
115!  Normal value
116!
117!---------------------------------------------------------------------------
118!
119!  Convert Heat fluxes to units used in POL subroutine dwl
120!
121!---------------------------------------------------------------------------
122      cp=3986.0d0
123
124    DO jj = 2, jpj
125         DO ji = fs_2, fs_jpim1
126           qsr(ji,jj)  = qsr(ji,jj)  * (r1_rau0_rcp)
127         ENDDO       !ji
128    ENDDO            !jj
129!--------------------------------------------------------------------------------
130      if ( first ) then
131        rlambda2(:,:) = 0.0
132        first=.false.
133        if ( ln_vary_lambda ) then
134!        do j=1,jesub    ! Original Polcoms style Loop
135!          do i=1,iesub  ! Original Polcoms style Loop
136
137        do jj=2,jpjm1
138          do ji = fs_2, fs_jpim1   ! vector opt.
139              if (tmask(ji,jj,0) == 1)  then   
140
141!             if(ipexb(i,j).ne. 0) then  (Mask, use Tmask instead)
142
143
144              !JT
145              !hbatt = gdept_n(ji,jj, k_bot(ji,jj) )
146              hbatt = sum( e3t_n(ji,jj,:)*tmask(ji,jj,:) )
147
148              rlambda2(ji,jj)=-0.033*log(hbatt)+0.2583    ! JIAs formula
149              !JT
150
151
152              !JT 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              !WRITE(*,300) 'JT tradwl:',jj,ji,njmpp,jpjglo,nimpp,jpiglo,narea, hbatt, rlambda2(ji,jj)
157!300 FORMAT(A14,1X,I4,1X,I4,1X,I5,1X,I5,1X,I5,1X,I5,1X,I5,1X,f9.3,1X,f9.2)
158
159
160!              WRITE(*,300) 'JT tradwl:',jj,ji,njmpp+jj,nimpp+ji,njmpp,nimpp,narea, hbatt, rlambda2(ji,jj)
161               !domain size jpjglo,,jpiglo
162               !lower lhs of each sub-domain = nimpp,njmpp
163               ! index on the global domain??? add or subtract one?? = njmpp+jj,nimpp+ji
164!300 FORMAT(A14,1X,I4,1X,I4,1X,I5,1X,I5,1X,I5,1X,I5,1X,I5,1X,f9.3,1X,f9.2)
165
166
167!              if (kt == 1) WRITE(*,300) 'JT tradwl:',njmpp+jj,nimpp+ji, hbatt, rlambda2(ji,jj)
168               !domain size jpjglo,,jpiglo
169               !lower lhs of each sub-domain = nimpp,njmpp
170               ! index on the global domain??? add or subtract one?? = njmpp+jj,nimpp+ji
171!300 FORMAT(A14,1X,I4,1X,I4,1X,f9.3,1X,f9.2)
172
173
174            else
175                rlambda2(ji,jj)= 0.25
176            endif
177          enddo ! ji
178        enddo ! jj
179        rlambda = 0.0
180       else
181        rLambda=0.154
182       endif ! If vary lambda
183      endif ! If first
184
185!      do j=1,jesub      ! Original Polcoms Style Loop
186!        do i=1,iesub    ! Original Polcoms Style Loop
187      DO jk=2,jpk
188         DO jj=2,jpjm1
189            DO ji = fs_2, fs_jpim1   ! vector opt.
190
191              if (tmask(ji,jj,0) == 1)  then   
192    !--------------------------------------------------------------------
193    ! Calculate change in temperature
194    !--------------------------------------------------------------------
195    !
196    !        rad0 = hfl_in(i,j)   ! change hfl_in to qsr I assume
197
198                    rad0 = qsr(ji,jj)
199                    rD = rLambda2(ji,jj)  +rLambda      !  Transmissivity to be used here
200    !       if rlambda 0 then rlambda2 not zer and vica versa
201
202                    z2=gdepw_0(ji,jj,jk-1)    ! grid box is from z=z1 to z=z2
203                    z1=gdepw_0(ji,jj,jk)
204
205                    Rad2=Rad0*(exp(-z2*rD)) ! radiation entering box
206                    Rad1=Rad0*(exp(-z1*rD)) ! radiation leaving box
207
208
209                    dtmp(jk)=1.0/(e3t_0(ji,jj,jk))*(Rad2-Rad1) !change in temperature
210                    tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + dtmp(jk)
211                endif
212            enddo  ! ji
213         enddo  ! jj
214      enddo !jk
215
216
217      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics
218         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
219         !CEODCALL trd_mod( ztrdt, ztrds, jptra_trd_qsr, 'TRA', kt )
220      ENDIF
221      !                       ! print mean trends (used for debugging)
222      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
223      !
224   END SUBROUTINE tra_dwl
225
226
227   SUBROUTINE tra_dwl_init
228      !!----------------------------------------------------------------------
229      !!                  ***  ROUTINE tra_dwl_init  ***
230      !!
231      !! ** Purpose :   Initialization for the penetrative solar radiation for Downwell routine
232      !!
233      !! ** Method  :   The profile of solar radiation within the ocean is set
234      !!      from two length scale of penetration (rn_si0,rn_si1) and a ratio
235      !!      (rn_abs). These parameters are read in the namtra_qsr namelist. The
236      !!      default values correspond to clear water (type I in Jerlov'
237      !!      (1968) classification.
238      !!         called by tra_qsr at the first timestep (nit000)
239      !!
240      !! ** Action  : - initialize rn_si0, rn_si1 and rn_abs
241      !!
242      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
243      !!----------------------------------------------------------------------
244      INTEGER  ::   ji, jj, jk            ! dummy loop indices
245      INTEGER  ::   ios                   ! Local integer output status for namelist read
246      INTEGER  ::   irgb, ierror          ! temporary integer
247      INTEGER  ::   ioptio, nqsr          ! temporary integer
248      REAL(wp) ::   zc0  , zc1            ! temporary scalars
249      REAL(wp) ::   zc2  , zc3  , zchl    !    -         -
250      REAL(wp) ::   zsi0r, zsi1r, zcoef   !    -         -
251      REAL(wp), DIMENSION(jpi,jpj)     ::   zekb, zekg, zekr              ! 2D workspace
252      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze0 , ze1 , ze2 , ze3 , zea   ! 3D workspace
253      !!
254      CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files
255      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read
256      NAMELIST/namtra_dwl/  ln_tradwl, ln_vary_lambda
257      !!----------------------------------------------------------------------
258
259      REWIND( numnam_ref )            ! Read Namelist namtra_dwl in reference namelist :
260      READ  ( numnam_ref, namtra_dwl, IOSTAT = ios, ERR = 901)
261901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_qsr in reference namelist')
262     
263      REWIND( numnam_cfg )            ! Read Namelist namtra_dwl in configuration namelist :
264      READ  ( numnam_cfg, namtra_dwl, IOSTAT = ios, ERR = 902)
265902   IF( ios > 0 ) CALL ctl_nam ( ios , 'namtra_qsr in configuration namelist')
266      !
267      IF(lwp) THEN                ! control print
268         WRITE(numout,*)
269         WRITE(numout,*) 'tra_dwl_init : '
270         WRITE(numout,*) '~~~~~~~~~~~~'
271         WRITE(numout,*) '   Namelist namtra_dwl : set the parameter of penetration'
272         WRITE(numout,*) '      Light penetration (T) or not (F)         ln_tradwl  = ', ln_tradwl
273         WRITE(numout,*) '      Vary Lambda  (T) or not (F))             ln_vary_lambda  = ', ln_vary_lambda
274      ENDIF
275
276   END SUBROUTINE tra_dwl_init
277
278   !!======================================================================
279END MODULE tradwl
Note: See TracBrowser for help on using the repository browser.