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.
zdfmxl.F90 in tags/nemo_v3_2/nemo_v3_2/NEMO/OFF_SRC/ZDF – NEMO

source: tags/nemo_v3_2/nemo_v3_2/NEMO/OFF_SRC/ZDF/zdfmxl.F90 @ 1878

Last change on this file since 1878 was 1878, checked in by flavoni, 14 years ago

initial test for nemogcm

File size: 5.2 KB
Line 
1MODULE zdfmxl
2   !!======================================================================
3   !!                       ***  MODULE  zdfmxl  ***
4   !! Ocean physics: mixed layer depth
5   !!======================================================================
6   !! History :
7   !!   9.0  !  03-08  (G. Madec)  OpenMP/autotasking optimization
8   !!----------------------------------------------------------------------
9   !!   zdf_mxl      : Compute the turbocline and mixed layer depths.
10   !!----------------------------------------------------------------------
11   !! * Modules used
12   USE oce             ! ocean dynamics and tracers variables
13   USE dom_oce         ! ocean space and time domain variables
14   USE zdf_oce         ! ocean vertical physics
15   USE in_out_manager  ! I/O manager
16   USE prtctl          ! Print control
17
18   IMPLICIT NONE
19   PRIVATE
20
21   !! * Routine accessibility
22   PUBLIC zdf_mxl           ! called by step.F90
23
24   !! * Shared module variables
25   INTEGER, PUBLIC, DIMENSION(jpi,jpj) ::   &   !:
26      nmln                  !: number of level in the mixed layer
27   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !:
28      hmld ,             &  !: mixing layer depth (turbocline) (m)
29      hmlp ,             &  !: mixed layer depth  (rho=rho0+zdcrit) (m)
30      hmlpt                 !: mixed layer depth at t-points (m)
31
32   !! * module variables
33   REAL(wp) ::   &
34      avt_c = 5.e-4_wp,  &  ! Kz criterion for the turbocline depth
35      rho_c = 0.01_wp       ! density criterion for mixed layer depth
36
37   !! * Substitutions
38#  include "domzgr_substitute.h90"
39   !!----------------------------------------------------------------------
40   !!   OPA 9.0 , LOCEAN-IPSL (2005)
41   !! $Id: zdfmxl.F90 1326 2009-02-20 10:08:16Z cetlod $
42   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
43   !!----------------------------------------------------------------------
44
45CONTAINS
46
47   SUBROUTINE zdf_mxl( kt )
48      !!----------------------------------------------------------------------
49      !!                  ***  ROUTINE zdfmxl  ***
50      !!                   
51      !! ** Purpose :   Compute the turbocline depth and the mixed layer depth
52      !!      with density criteria.
53      !!
54      !! ** Method  :   The turbocline depth is the depth at which the vertical
55      !!      eddy diffusivity coefficient (resulting from the vertical physics
56      !!      alone, not the isopycnal part, see trazdf.F) fall below a given
57      !!      value defined locally (avt_c here taken equal to 5 cm/s2)
58      !!
59      !! ** Action  :
60      !!
61      !! History :
62      !!        !  94-11  (M. Imbard)  Original code
63      !!   8.0  !  96-01  (E. Guilyardi)  sub mixed layer temp.
64      !!   8.1  !  97-07  (G. Madec)  optimization
65      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
66      !!----------------------------------------------------------------------
67      !! * Arguments
68      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
69
70      !! * Local declarations
71      INTEGER ::   ji, jj, jk     ! dummy loop indices
72      INTEGER ::   ik             ! temporary integer
73      INTEGER, DIMENSION(jpi,jpj) ::   &
74         imld                     ! temporary workspace
75      !!----------------------------------------------------------------------
76
77      IF( kt == nit000 ) THEN
78         IF(lwp) WRITE(numout,*)
79         IF(lwp) WRITE(numout,*) 'zdf_mxl : mixed layer depth'
80         IF(lwp) WRITE(numout,*) '~~~~~~~ '
81      ENDIF
82
83
84      ! 1. Turbocline depth
85      ! -------------------
86      ! last w-level at which avt<avt_c (starting from the bottom jk=jpk)
87      ! (since avt(.,.,jpk)=0, we have jpk=< imld =< 2 )
88      DO jk = jpk, 2, -1
89         DO jj = 1, jpj
90            DO ji = 1, jpi
91               IF( avt(ji,jj,jk) < avt_c ) imld(ji,jj) = jk 
92            END DO
93         END DO
94      END DO
95
96      ! Turbocline depth and sub-turbocline temperature
97      DO jj = 1, jpj
98         DO ji = 1, jpi
99            ik = imld(ji,jj)
100            hmld (ji,jj) = fsdepw(ji,jj,ik) * tmask(ji,jj,1)
101         END DO
102      END DO
103
104!!gm idea
105!!   
106!!gm  DO jk = jpk, 2, -1
107!!gm     DO jj = 1, jpj
108!!gm        DO ji = 1, jpi
109!!gm           IF( avt(ji,jj,jk) < avt_c ) hmld(ji,jj) = fsdepw(ji,jj,jk) * tmask(ji,jj,1)
110!!gm        END DO
111!!gm     END DO
112!!gm  END DO
113!!gm
114
115      ! 2. Mixed layer depth
116      ! --------------------
117      ! Initialization to the number of w ocean point mbathy
118      nmln(:,:) = mbathy(:,:)
119
120      ! Last w-level at which rhop>=rho surf+rho_c (starting from jpk-1)
121      ! (rhop defined at t-point, thus jk-1 for w-level just above)
122      DO jk = jpkm1, 2, -1
123         DO jj = 1, jpj
124            DO ji = 1, jpi
125               IF( rhop(ji,jj,jk) > rhop(ji,jj,1) + rho_c )   nmln(ji,jj) = jk
126            END DO
127         END DO
128      END DO
129
130      ! Mixed layer depth
131      DO jj = 1, jpj
132         DO ji = 1, jpi
133            ik = nmln(ji,jj)
134            hmlp (ji,jj) = fsdepw(ji,jj,ik) * tmask(ji,jj,1)
135            hmlpt(ji,jj) = fsdept(ji,jj,ik-1)
136         END DO
137      END DO
138
139      IF(ln_ctl)   CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmld, clinfo2=' hmld : ', ovlap=1 )
140
141   END SUBROUTINE zdf_mxl
142
143   !!======================================================================
144END MODULE zdfmxl
Note: See TracBrowser for help on using the repository browser.