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

Last change on this file since 15314 was 15314, checked in by hadjt, 2 years ago

TRA/tradwl.F90

TRA/tradwl.F90 was not included in the previous fcm commit, as it was a new file, and not added to the version control.

added now with

fcm add --check
File size: 10.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
140!             if(ipexb(i,j).ne. 0) then  (Mask, use Tmask instead)
141
142
143              !JT
144              !hbatt = gdept_n(ji,jj, k_bot(ji,jj) )
145              hbatt = sum( e3t_n(ji,jj,:)*tmask(ji,jj,:) )
146
147              rlambda2(ji,jj)=-0.033*log(hbatt)+0.2583    ! JIAs formula
148              !JT
149
150
151              !JT rlambda2(ji,jj)=-0.033*log(hbatt(ji,jj))+0.2583    ! JIAs formula
152              rlambda2(ji,jj)=max(0.05,rlambda2(ji,jj))     ! limit in deep water
153              rlambda2(ji,jj)=min(0.25,rlambda2(ji,jj))     ! Catch the infinities, from very shallow water/land. 10cm = 0.25
154
155              WRITE(*,300) 'JT tradwl:',jj,ji,njmpp,jpjglo,nimpp,jpiglo,narea, hbatt, rlambda2(ji,jj)
156
157
158300 FORMAT(A14,1X,I4,1X,I4,1X,I5,1X,I5,1X,I5,1X,I5,1X,I5,1X,f9.3,1X,f9.2)
159
160          enddo ! ji
161        enddo ! jj
162        rlambda = 0.0
163       else
164        rLambda=0.154
165       endif ! If vary lambda
166      endif ! If first
167
168!      do j=1,jesub      ! Original Polcoms Style Loop
169!        do i=1,iesub    ! Original Polcoms Style Loop
170      DO jk=2,jpk
171         DO jj=2,jpjm1
172            DO ji = fs_2, fs_jpim1   ! vector opt.
173
174!--------------------------------------------------------------------
175! Calculate change in temperature
176!--------------------------------------------------------------------
177!
178!        rad0 = hfl_in(i,j)   ! change hfl_in to qsr I assume
179
180                rad0 = qsr(ji,jj)
181                rD = rLambda2(ji,jj)  +rLambda      !  Transmissivity to be used here
182!       if rlambda 0 then rlambda2 not zer and vica versa
183
184                z2=gdepw_0(ji,jj,jk-1)    ! grid box is from z=z1 to z=z2
185                z1=gdepw_0(ji,jj,jk)
186
187                Rad2=Rad0*(exp(-z2*rD)) ! radiation entering box
188                Rad1=Rad0*(exp(-z1*rD)) ! radiation leaving box
189
190
191                dtmp(jk)=1.0/(e3t_0(ji,jj,jk))*(Rad2-Rad1) !change in temperature
192                tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + dtmp(jk)
193            enddo  ! ji
194         enddo  ! jj
195      enddo !jk
196
197
198      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics
199         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
200         !CEODCALL trd_mod( ztrdt, ztrds, jptra_trd_qsr, 'TRA', kt )
201      ENDIF
202      !                       ! print mean trends (used for debugging)
203      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' qsr  - Ta: ', mask1=tmask, clinfo3='tra-ta' )
204      !
205   END SUBROUTINE tra_dwl
206
207
208   SUBROUTINE tra_dwl_init
209      !!----------------------------------------------------------------------
210      !!                  ***  ROUTINE tra_dwl_init  ***
211      !!
212      !! ** Purpose :   Initialization for the penetrative solar radiation for Downwell routine
213      !!
214      !! ** Method  :   The profile of solar radiation within the ocean is set
215      !!      from two length scale of penetration (rn_si0,rn_si1) and a ratio
216      !!      (rn_abs). These parameters are read in the namtra_qsr namelist. The
217      !!      default values correspond to clear water (type I in Jerlov'
218      !!      (1968) classification.
219      !!         called by tra_qsr at the first timestep (nit000)
220      !!
221      !! ** Action  : - initialize rn_si0, rn_si1 and rn_abs
222      !!
223      !! Reference : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
224      !!----------------------------------------------------------------------
225      INTEGER  ::   ji, jj, jk            ! dummy loop indices
226      INTEGER  ::   ios                   ! Local integer output status for namelist read
227      INTEGER  ::   irgb, ierror          ! temporary integer
228      INTEGER  ::   ioptio, nqsr          ! temporary integer
229      REAL(wp) ::   zc0  , zc1            ! temporary scalars
230      REAL(wp) ::   zc2  , zc3  , zchl    !    -         -
231      REAL(wp) ::   zsi0r, zsi1r, zcoef   !    -         -
232      REAL(wp), DIMENSION(jpi,jpj)     ::   zekb, zekg, zekr              ! 2D workspace
233      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze0 , ze1 , ze2 , ze3 , zea   ! 3D workspace
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.