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.
phycst.F90 in branches/2014/dev_r4627_COMODO_UPW2D/NEMOGCM/CONFIG/UPW2D_eo_NOadv_vvl_EXP/MY_SRC – NEMO

source: branches/2014/dev_r4627_COMODO_UPW2D/NEMOGCM/CONFIG/UPW2D_eo_NOadv_vvl_EXP/MY_SRC/phycst.F90 @ 4648

Last change on this file since 4648 was 4648, checked in by flavoni, 10 years ago

add new experience for cas test Upwelling, for WP item CNRS-7

File size: 13.6 KB
Line 
1MODULE phycst
2   !!======================================================================
3   !!                    ***  MODULE  phycst  ***
4   !!     Definition of of both ocean and ice parameters used in the code
5   !!=====================================================================
6   !! History :   OPA  !  1990-10  (C. Levy - G. Madec)  Original code
7   !!             8.1  !  1991-11  (G. Madec, M. Imbard)  cosmetic changes
8   !!   NEMO      1.0  !  2002-08  (G. Madec, C. Ethe)  F90, add ice constants
9   !!              -   !  2006-08  (G. Madec)  style
10   !!             3.2  !  2006-08  (S. Masson, G. Madec)  suppress useless variables + style
11   !!             3.4  !  2011-11  (C. Harris)  minor changes for CICE constants
12   !!----------------------------------------------------------------------
13
14   !!----------------------------------------------------------------------
15   !!   phy_cst  : define and print physical constant and domain parameters
16   !!----------------------------------------------------------------------
17   USE par_oce          ! ocean parameters
18   USE in_out_manager   ! I/O manager
19
20   IMPLICIT NONE
21   PRIVATE
22
23   PUBLIC   phy_cst     ! routine called by inipar.F90
24
25   REAL(wp), PUBLIC ::   rpi = 3.141592653589793_wp             !: pi
26   REAL(wp), PUBLIC ::   rad = 3.141592653589793_wp / 180._wp   !: conversion from degre into radian
27   REAL(wp), PUBLIC ::   rsmall = 0.5 * EPSILON( 1.e0 )         !: smallest real computer value
28   
29   REAL(wp), PUBLIC ::   rday = 24.*60.*60.     !: day                                [s]
30   REAL(wp), PUBLIC ::   rsiyea                 !: sideral year                       [s]
31   REAL(wp), PUBLIC ::   rsiday                 !: sideral day                        [s]
32   REAL(wp), PUBLIC ::   raamo =  12._wp        !: number of months in one year
33   REAL(wp), PUBLIC ::   rjjhh =  24._wp        !: number of hours in one day
34   REAL(wp), PUBLIC ::   rhhmm =  60._wp        !: number of minutes in one hour
35   REAL(wp), PUBLIC ::   rmmss =  60._wp        !: number of seconds in one minute
36   REAL(wp), PUBLIC ::   omega                  !: earth rotation parameter           [s-1]
37   REAL(wp), PUBLIC ::   ra    = 6371229._wp    !: earth radius                       [m]
38   REAL(wp), PUBLIC ::   grav  = 9.80665_wp     !: gravity                            [m/s2]
39   
40   REAL(wp), PUBLIC ::   rtt      = 273.16_wp        !: triple point of temperature   [Kelvin]
41   REAL(wp), PUBLIC ::   rt0      = 273.15_wp        !: freezing point of fresh water [Kelvin]
42#if defined key_lim3
43   REAL(wp), PUBLIC ::   rt0_snow = 273.16_wp        !: melting point of snow         [Kelvin]
44   REAL(wp), PUBLIC ::   rt0_ice  = 273.16_wp        !: melting point of ice          [Kelvin]
45#else
46   REAL(wp), PUBLIC ::   rt0_snow = 273.15_wp        !: melting point of snow         [Kelvin]
47   REAL(wp), PUBLIC ::   rt0_ice  = 273.05_wp        !: melting point of ice          [Kelvin]
48#endif
49#if defined key_cice
50   REAL(wp), PUBLIC ::   rau0     = 1026._wp         !: volumic mass of reference     [kg/m3]
51#else
52!Special case upwelling
53!SF   REAL(wp), PUBLIC ::   rau0     = 1035._wp         !: volumic mass of reference     [kg/m3]
54   REAL(wp), PUBLIC ::   rau0     = 1000._wp         !: volumic mass of reference     [kg/m3]
55#endif
56   REAL(wp), PUBLIC ::   r1_rau0                     !: = 1. / rau0                   [m3/kg]
57   REAL(wp), PUBLIC ::   rauw     = 1000._wp         !: volumic mass of pure water    [m3/kg]
58   REAL(wp), PUBLIC ::   rcp      =    4.e3_wp       !: ocean specific heat           [J/Kelvin]
59   REAL(wp), PUBLIC ::   r1_rcp                      !: = 1. / rcp                    [Kelvin/J]
60   REAL(wp), PUBLIC ::   r1_rau0_rcp                 !: = 1. / ( rau0 * rcp )
61
62   REAL(wp), PUBLIC ::   rhosn    =  330._wp         !: volumic mass of snow          [kg/m3]
63   REAL(wp), PUBLIC ::   emic     =    0.97_wp       !: emissivity of snow or ice
64   REAL(wp), PUBLIC ::   sice     =    6.0_wp        !: salinity of ice               [psu]
65   REAL(wp), PUBLIC ::   soce     =   34.7_wp        !: salinity of sea               [psu]
66   REAL(wp), PUBLIC ::   cevap    =    2.5e+6_wp     !: latent heat of evaporation (water)
67   REAL(wp), PUBLIC ::   srgamma  =    0.9_wp        !: correction factor for solar radiation (Oberhuber, 1974)
68   REAL(wp), PUBLIC ::   vkarmn   =    0.4_wp        !: von Karman constant
69   REAL(wp), PUBLIC ::   stefan   =    5.67e-8_wp    !: Stefan-Boltzmann constant
70
71#if defined key_lim3 || defined key_cice
72   REAL(wp), PUBLIC ::   rhoic    =  917._wp         !: volumic mass of sea ice                               [kg/m3]
73   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice
74   REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow
75   REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice
76   REAL(wp), PUBLIC ::   lsub     =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg]
77   REAL(wp), PUBLIC ::   lfus     =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg]
78   REAL(wp), PUBLIC ::   tmut     =    0.054_wp      !: decrease of seawater meltpoint with salinity
79   REAL(wp), PUBLIC ::   xlsn                        !: = lfus*rhosn (volumetric latent heat fusion of snow)  [J/m3]
80#else
81   REAL(wp), PUBLIC ::   rhoic    =  900._wp         !: volumic mass of sea ice                               [kg/m3]
82   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: conductivity of the ice                               [W/m/K]
83   REAL(wp), PUBLIC ::   rcpic    =    1.8837e+6_wp  !: volumetric specific heat for ice                      [J/m3/K]
84   REAL(wp), PUBLIC ::   cpic                        !: = rcpic / rhoic  (specific heat for ice)              [J/Kg/K]
85   REAL(wp), PUBLIC ::   rcdsn    =    0.22_wp       !: conductivity of the snow                              [W/m/K]
86   REAL(wp), PUBLIC ::   rcpsn    =    6.9069e+5_wp  !: volumetric specific heat for snow                     [J/m3/K]
87   REAL(wp), PUBLIC ::   xlsn     =  110.121e+6_wp   !: volumetric latent heat fusion of snow                 [J/m3]
88   REAL(wp), PUBLIC ::   lfus                        !: = xlsn / rhosn   (latent heat of fusion of fresh ice) [J/Kg]
89   REAL(wp), PUBLIC ::   xlic     =  300.33e+6_wp    !: volumetric latent heat fusion of ice                  [J/m3]
90   REAL(wp), PUBLIC ::   xsn      =    2.8e+6_wp     !: volumetric latent heat of sublimation of snow         [J/m3]
91#endif
92   !!----------------------------------------------------------------------
93   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
94   !! $Id: phycst.F90 3625 2012-11-21 13:19:18Z acc $
95   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
96   !!----------------------------------------------------------------------
97   
98CONTAINS
99   
100   SUBROUTINE phy_cst
101      !!----------------------------------------------------------------------
102      !!                       ***  ROUTINE phy_cst  ***
103      !!
104      !! ** Purpose :   Print model parameters and set and print the constants
105      !!----------------------------------------------------------------------
106      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7) )" 
107      !!----------------------------------------------------------------------
108
109      IF(lwp) WRITE(numout,*)
110      IF(lwp) WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants'
111      IF(lwp) WRITE(numout,*) ' ~~~~~~~'
112
113      ! Ocean Parameters
114      ! ----------------
115      IF(lwp) THEN
116         WRITE(numout,*) '       Domain info'
117         WRITE(numout,*) '          dimension of model'
118         WRITE(numout,*) '                 Local domain      Global domain       Data domain '
119         WRITE(numout,cform) '            ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo, '   jpidta  : ', jpidta
120         WRITE(numout,cform) '            ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo, '   jpjdta  : ', jpjdta
121         WRITE(numout,cform) '            ','   jpk     : ', jpk, '   jpk     : ', jpk   , '   jpkdta  : ', jpkdta
122         WRITE(numout,*)      '           ','   jpij    : ', jpij
123         WRITE(numout,*) '          mpp local domain info (mpp)'
124         WRITE(numout,*) '             jpni    : ', jpni, '   jpreci  : ', jpreci
125         WRITE(numout,*) '             jpnj    : ', jpnj, '   jprecj  : ', jprecj
126         WRITE(numout,*) '             jpnij   : ', jpnij
127         WRITE(numout,*) '          lateral domain boundary condition type : jperio  = ', jperio
128      ENDIF
129
130      ! Define constants
131      ! ----------------
132      IF(lwp) WRITE(numout,*)
133      IF(lwp) WRITE(numout,*) '       Constants'
134
135      IF(lwp) WRITE(numout,*)
136      IF(lwp) WRITE(numout,*) '          mathematical constant                 rpi = ', rpi
137
138      rsiyea = 365.25_wp * rday * 2._wp * rpi / 6.283076_wp
139      rsiday = rday / ( 1._wp + rday / rsiyea )
140#if defined key_cice
141      omega  = 7.292116e-05
142#else
143      omega  = 2._wp * rpi / rsiday 
144#endif
145      IF(lwp) WRITE(numout,*)
146      IF(lwp) WRITE(numout,*) '          day                                rday   = ', rday,   ' s'
147      IF(lwp) WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s'
148      IF(lwp) WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s'
149      IF(lwp) WRITE(numout,*) '          omega                              omega  = ', omega,  ' s^-1'
150
151      IF(lwp) WRITE(numout,*)
152      IF(lwp) WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months'
153      IF(lwp) WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours'
154      IF(lwp) WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn'
155      IF(lwp) WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s'
156
157      IF(lwp) WRITE(numout,*)
158      IF(lwp) WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m'
159      IF(lwp) WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2'
160
161      IF(lwp) WRITE(numout,*)
162      IF(lwp) WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K'
163      IF(lwp) WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K'
164      IF(lwp) WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K'
165      IF(lwp) WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K'
166
167      r1_rau0     = 1._wp / rau0
168      r1_rcp      = 1._wp / rcp
169      r1_rau0_rcp = 1._wp / ( rau0 * rcp )
170      IF(lwp) WRITE(numout,*)
171      IF(lwp) WRITE(numout,*) '          volumic mass of pure water          rauw  = ', rauw   , ' kg/m^3'
172      IF(lwp) WRITE(numout,*) '          volumic mass of reference           rau0  = ', rau0   , ' kg/m^3'
173      IF(lwp) WRITE(numout,*) '          1. / rau0                        r1_rau0  = ', r1_rau0, ' m^3/kg'
174      IF(lwp) WRITE(numout,*) '          ocean specific heat                 rcp   = ', rcp    , ' J/Kelvin'
175      IF(lwp) WRITE(numout,*) '          1. / ( rau0 * rcp )           r1_rau0_rcp = ', r1_rau0_rcp
176
177
178#if defined key_lim3 || defined key_cice
179      xlsn = lfus * rhosn        ! volumetric latent heat fusion of snow [J/m3]
180#else
181      cpic = rcpic / rhoic       ! specific heat for ice   [J/Kg/K]
182      lfus = xlsn / rhosn        ! latent heat of fusion of fresh ice
183#endif
184
185      IF(lwp) THEN
186         WRITE(numout,*)
187         WRITE(numout,*) '          thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K'
188         WRITE(numout,*) '          thermal conductivity of the ice           = ', rcdic   , ' J/s/m/K'
189         WRITE(numout,*) '          fresh ice specific heat                   = ', cpic    , ' J/kg/K'
190         WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg'
191#if defined key_lim3 || defined key_cice
192         WRITE(numout,*) '          latent heat of subl.  of fresh ice / snow = ', lsub    , ' J/kg'
193#else
194         WRITE(numout,*) '          density times specific heat for snow      = ', rcpsn   , ' J/m^3/K' 
195         WRITE(numout,*) '          density times specific heat for ice       = ', rcpic   , ' J/m^3/K'
196         WRITE(numout,*) '          volumetric latent heat fusion of sea ice  = ', xlic    , ' J/m' 
197         WRITE(numout,*) '          latent heat of sublimation of snow        = ', xsn     , ' J/kg' 
198#endif
199         WRITE(numout,*) '          volumetric latent heat fusion of snow     = ', xlsn    , ' J/m^3' 
200         WRITE(numout,*) '          density of sea ice                        = ', rhoic   , ' kg/m^3'
201         WRITE(numout,*) '          density of snow                           = ', rhosn   , ' kg/m^3'
202         WRITE(numout,*) '          emissivity of snow or ice                 = ', emic 
203         WRITE(numout,*) '          salinity of ice                           = ', sice    , ' psu'
204         WRITE(numout,*) '          salinity of sea                           = ', soce    , ' psu'
205         WRITE(numout,*) '          latent heat of evaporation (water)        = ', cevap   , ' J/m^3' 
206         WRITE(numout,*) '          correction factor for solar radiation     = ', srgamma 
207         WRITE(numout,*) '          von Karman constant                       = ', vkarmn 
208         WRITE(numout,*) '          Stefan-Boltzmann constant                 = ', stefan  , ' J/s/m^2/K^4'
209         WRITE(numout,*)
210         WRITE(numout,*) '          conversion: degre ==> radian          rad = ', rad
211         WRITE(numout,*)
212         WRITE(numout,*) '          smallest real computer value       rsmall = ', rsmall
213      ENDIF
214
215   END SUBROUTINE phy_cst
216
217   !!======================================================================
218END MODULE phycst
Note: See TracBrowser for help on using the repository browser.