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_r6912_GO6_package/NEMOGCM/NEMO/OPA_SRC – NEMO

source: branches/UKMO/dev_r6912_GO6_package/NEMOGCM/NEMO/OPA_SRC/oce.F90 @ 9132

Last change on this file since 9132 was 9132, checked in by andmirek, 6 years ago

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