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 branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/OPA_SRC/TRA/tradwl.F90 @ 8059

Last change on this file since 8059 was 8059, checked in by jgraham, 7 years ago

Merged branches required for AMM15 simulations, see ticket #1904.
Merged branches include:
branches/UKMO/CO6_KD490
branches/UKMO/CO6_Restartable_Tidal_Analysis
branches/UKMO/AMM15_v3_6_STABLE

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