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.
oce.F90 in branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/oce.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 4 years ago

The Dr Hook changes from my perl code.

File size: 10.6 KB
Line 
1MODULE oce
2   !!======================================================================
3   !!                      ***  MODULE  oce  ***
4   !! Ocean        :  dynamics and active tracers defined in memory
5   !!======================================================================
6   !! History :  1.0  !  2002-11  (G. Madec)  F90: Free form and module
7   !!            3.1  !  2009-02  (G. Madec, M. Leclair)  pure z* coordinate
8   !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add ts, gtsu, gtsv 4D arrays
9   !!----------------------------------------------------------------------
10   USE par_oce        ! ocean parameters
11   USE lib_mpp        ! MPP library
12
13   USE yomhook, ONLY: lhook, dr_hook
14   USE parkind1, ONLY: jprb, jpim
15
16   IMPLICIT NONE
17   PRIVATE
18
19   PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90
20
21   LOGICAL, PUBLIC ::   l_traldf_rot = .FALSE.  !: rotated laplacian operator for lateral diffusion
22
23   !! dynamics and tracer fields                            ! before ! now    ! after  ! the after trends becomes the fields
24   !! --------------------------                            ! fields ! fields ! trends ! only after tra_zdf and dyn_spg
25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua     !: i-horizontal velocity          [m/s]
26   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va     !: j-horizontal velocity          [m/s]
27   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   ua_sv,  va_sv          !: Saved trends (time spliting)   [m/s2]
28   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::           wn             !: vertical velocity              [m/s]
29   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rotb ,  rotn           !: relative vorticity             [s-1]
30   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hdivb,  hdivn          !: horizontal divergence          [s-1]
31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa    !: 4D T-S fields                  [Celcius,psu]
32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_b,  rab_n          !: thermal/haline expansion coef. [Celcius-1,psu-1]
33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2     [s-2]
34   !
35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units]
36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhop   !: potential volumic mass                           [kg/m3]
37
38   !! free surface                                      !  before  ! now    ! after  !
39   !! ------------                                      !  fields  ! fields ! fields !
40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub_b   ,  un_b  ,  ua_b  !: Barotropic velocities at u-point [m/s]
41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vb_b   ,  vn_b  ,  va_b  !: Barotropic velocities at v-point [m/s]
42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshb   ,  sshn  ,  ssha  !: sea surface height at t-point [m]
43   !
44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   spgu, spgv               !: horizontal surface pressure gradient
45
46   !! interpolated gradient (only used in zps case)
47   !! ---------------------
48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gtsu, gtsv   !: horizontal gradient of T, S bottom u-point
49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gru , grv    !: horizontal gradient of rd at bottom u-point
50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   aru , arv   
51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gzu , gzv   
52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ge3ru, ge3rv   !: horizontal gradient of T, S and rd at top v-point 
53
54   !! (ISF) interpolated gradient (only used for ice shelf case)
55   !! ---------------------
56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gtui, gtvi   !: horizontal gradient of T, S and rd at top u-point
57   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   grui, grvi   !: horizontal gradient of T, S and rd at top v-point 
58   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   arui, arvi   !: horizontal average  of rd          at top v-point 
59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gzui, gzvi   !: horizontal gradient of z           at top v-point 
60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ge3rui, ge3rvi   !: horizontal gradient of T, S and rd at top v-point 
61   !! (ISF) ice load
62   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   riceload
63
64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rke          !: kinetic energy
65
66   !! arrays relating to embedding ice in the ocean. These arrays need to be declared
67   !! even if no ice model is required. In the no ice model or traditional levitating
68   !! ice cases they contain only zeros
69   !! ---------------------
70   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass        !: mass of snow and ice at current  ice time step   [Kg/m2]
71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_mass_b      !: mass of snow and ice at previous ice time step   [Kg/m2]
72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   snwice_fmass       !: time evolution of mass of snow+ice               [Kg/m2/s]
73
74   !! Energy budget of the leads (open water embedded in sea ice)
75   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev        !: fraction of solar net radiation absorbed in the first ocean level [-]
76 
77   !! Arrays used in coupling when MEDUSA is present. These arrays need to be declared
78   !! even if MEDUSA is not active, to allow compilation, in which case they will not be allocated.
79   !! ---------------------
80   REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: CO2Flux_out_cpl(:,:)  ! Output coupling CO2 flux 
81   REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: DMS_out_cpl(:,:)      ! Output coupling DMS 
82   REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: chloro_out_cpl(:,:)   ! Output coupling chlorophyll
83                                                                ! (expected in Kg/M3) 
84
85   REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: PCO2a_in_cpl(:,:)     ! Input coupling CO2 partial pressure
86   REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: Dust_in_cpl(:,:)      ! Input coupling dust
87
88#if defined key_medusa
89   LOGICAL, PUBLIC, PARAMETER :: ln_medusa=.TRUE. ! Medusa switched on or off.
90#else
91   LOGICAL, PUBLIC, PARAMETER :: ln_medusa=.FALSE. ! Medusa switched on or off.
92#endif
93   !!----------------------------------------------------------------------
94   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
95   !! $Id$
96   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
97   !!----------------------------------------------------------------------
98CONTAINS
99
100   INTEGER FUNCTION oce_alloc()
101      !!----------------------------------------------------------------------
102      !!                   ***  FUNCTION oce_alloc  ***
103      !!----------------------------------------------------------------------
104      INTEGER :: ierr(5)
105      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
106      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
107      REAL(KIND=jprb)               :: zhook_handle
108
109      CHARACTER(LEN=*), PARAMETER :: RoutineName='OCE_ALLOC'
110
111      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
112
113      !!----------------------------------------------------------------------
114      ierr(:) = 0
115      !
116      ALLOCATE( ub   (jpi,jpj,jpk)      , un   (jpi,jpj,jpk)      , ua(jpi,jpj,jpk)       ,     &
117         &      vb   (jpi,jpj,jpk)      , vn   (jpi,jpj,jpk)      , va(jpi,jpj,jpk)       ,     &     
118         &      ua_sv(jpi,jpj,jpk)      , va_sv(jpi,jpj,jpk)      ,                             &     
119         &      wn   (jpi,jpj,jpk)      ,                                                       &
120         &      rotb (jpi,jpj,jpk)      , rotn (jpi,jpj,jpk)      ,                             &   
121         &      hdivb(jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             &
122         &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     &
123         &      rab_b(jpi,jpj,jpk,jpts) , rab_n(jpi,jpj,jpk,jpts) ,                             &
124         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)                              , STAT=ierr(1) )
125         !
126      ALLOCATE(rhd (jpi,jpj,jpk) ,                                         &
127         &     rhop(jpi,jpj,jpk) ,                                         &
128         &     rke(jpi,jpj,jpk)  ,                                         &
129         &     sshb(jpi,jpj)     , sshn(jpi,jpj)   , ssha(jpi,jpj)   ,     &
130         &     ub_b(jpi,jpj)     , un_b(jpi,jpj)   , ua_b(jpi,jpj)   ,     &
131         &     vb_b(jpi,jpj)     , vn_b(jpi,jpj)   , va_b(jpi,jpj)   ,     &
132         &     spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       &
133         &     gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     &
134         &     aru(jpi,jpj)      , arv(jpi,jpj)      ,                     &
135         &     gzu(jpi,jpj)      , gzv(jpi,jpj)      ,                     &
136         &     gru(jpi,jpj)      , grv(jpi,jpj)      ,                     &
137         &     ge3ru(jpi,jpj)    , ge3rv(jpi,jpj)    ,                     &
138         &     gtui(jpi,jpj,jpts), gtvi(jpi,jpj,jpts),                     &
139         &     arui(jpi,jpj)     , arvi(jpi,jpj)     ,                     &
140         &     gzui(jpi,jpj)     , gzvi(jpi,jpj)     ,                     &
141         &     ge3rui(jpi,jpj)   , ge3rvi(jpi,jpj)   ,                     &
142         &     grui(jpi,jpj)     , grvi(jpi,jpj)     ,                     &
143         &     riceload(jpi,jpj),                             STAT=ierr(2) )
144         !
145      ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(3) )
146         !
147      ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(4) )
148         !
149#if defined key_oasis3
150      IF (ln_medusa) THEN
151         ! We only actually need these arrays to be allocated if coupling and MEDUSA
152         ! are enabled
153         ALLOCATE( CO2Flux_out_cpl(jpi,jpj), DMS_out_cpl(jpi,jpj),               &
154                   chloro_out_cpl(jpi,jpj),                                      &
155                   PCO2a_in_cpl(jpi,jpj), Dust_in_cpl(jpi,jpj),     STAT=ierr(5) )
156
157      ENDIF
158#endif
159
160      oce_alloc = MAXVAL( ierr )
161      IF( oce_alloc /= 0 )   CALL ctl_warn('oce_alloc: failed to allocate arrays')
162      !
163      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
164   END FUNCTION oce_alloc
165
166   !!======================================================================
167END MODULE oce
Note: See TracBrowser for help on using the repository browser.