SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
modi_gltools_chkglo.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 !GLT_LIC The GELATO model is a seaice model used in stand-alone or embedded mode.
6 !GLT_LIC It has been developed by Meteo-France. The holder of GELATO is Meteo-France.
7 !GLT_LIC
8 !GLT_LIC This software is governed by the CeCILL-C license under French law and biding
9 !GLT_LIC by the rules of distribution of free software. See the CeCILL-C_V1-en.txt
10 !GLT_LIC (English) and CeCILL-C_V1-fr.txt (French) for details. The CeCILL is a free
11 !GLT_LIC software license, explicitly compatible with the GNU GPL
12 !GLT_LIC (see http://www.gnu.org/licenses/license-list.en.html#CeCILL)
13 !GLT_LIC
14 !GLT_LIC The CeCILL-C licence agreement grants users the right to modify and re-use the
15 !GLT_LIC software governed by this free software license. The exercising of this right
16 !GLT_LIC is conditional upon the obligation to make available to the community the
17 !GLT_LIC modifications made to the source code of the software so as to contribute to
18 !GLT_LIC its evolution.
19 !GLT_LIC
20 !GLT_LIC In consideration of access to the source code and the rights to copy, modify
21 !GLT_LIC and redistribute granted by the license, users are provided only with a limited
22 !GLT_LIC warranty and the software's author, the holder of the economic rights, and the
23 !GLT_LIC successive licensors only have limited liability. In this respect, the risks
24 !GLT_LIC associated with loading, using, modifying and/or developing or reproducing the
25 !GLT_LIC software by the user are brought to the user's attention, given its Free
26 !GLT_LIC Software status, which may make it complicated to use, with the result that its
27 !GLT_LIC use is reserved for developers and experienced professionals having in-depth
28 !GLT_LIC computer knowledge. Users are therefore encouraged to load and test the
29 !GLT_LIC suitability of the software as regards their requirements in conditions enabling
30 !GLT_LIC the security of their systems and/or data to be ensured and, more generally, to
31 !GLT_LIC use and operate it in the same conditions of security.
32 !GLT_LIC
33 !GLT_LIC The GELATO sofware is cureently distibuted with the SURFEX software, available at
34 !GLT_LIC http://www.cnrm.meteo.fr/surfex. The fact that you download the software deemed that
35 !GLT_LIC you had knowledge of the CeCILL-C license and that you accept its terms.
36 !GLT_LIC Attempts to use this software in a way not complying with CeCILL-C license
37 !GLT_LIC may lead to prosecution.
38 !GLT_LIC
39 ! =======================================================================
40 ! ====================== MODULE modi_gltools_chkglo =====================
41 ! =======================================================================
42 !
43 ! Goal:
44 ! -----
45 ! This module contains a subroutine that prints sea ice surface,
46 ! extent and volume separately in both hemispheres. Note these results
47 ! are printed only if nprinto flag is greater or equal to 2.
48 ! Note that mpp_sum (invoke all procs) cannot be used e.g. under
49 ! condition lp2==.TRUE. Hence we use nprinto.
50 !
51 ! Created : 1999 (D. Salas y Melia)
52 ! Repeated code doing that throughout the model is written in
53 ! a more standard form and only once in the present routine.
54 ! Modified: 2012/07 (D. Salas y Melia) parallelism
55 !
56 ! ------------------- BEGIN MODULE modi_gltools_chkglo ------------------
57 
58 !THXS_SFX!MODULE modi_gltools_chkglo
59 !THXS_SFX!INTERFACE
60 !THXS_SFX!
61 !THXS_SFX!SUBROUTINE gltools_chkglo(omsg,tpdom,tpsit)
62 !THXS_SFX! USE modd_types_glt
63 !THXS_SFX! USE modd_glt_param
64 !THXS_SFX! CHARACTER(*), INTENT(in) :: &
65 !THXS_SFX! omsg
66 !THXS_SFX! TYPE(t_dom), DIMENSION(nx,ny), INTENT(in) :: &
67 !THXS_SFX! tpdom
68 !THXS_SFX! TYPE(t_sit), DIMENSION(nt,nx,ny), INTENT(in) :: &
69 !THXS_SFX! tpsit
70 !THXS_SFX!END SUBROUTINE gltools_chkglo
71 !THXS_SFX!
72 !THXS_SFX!END INTERFACE
73 !THXS_SFX!END MODULE modi_gltools_chkglo
74 
75 ! -------------------- END MODULE modi_gltools_chkglo -------------------
76 
77 
78 ! -----------------------------------------------------------------------
79 ! --------------------- SUBROUTINE gltools_chkglo -----------------------
80 
81 ! * Subroutine used to check global sea ice extent, area and volume in
82 ! both hemispheres.
83 
84 SUBROUTINE gltools_chkglo(omsg,tpdom,tpsit)
85 !
87  USE modd_types_glt
88  USE modd_glt_param
89 #if ! defined in_arpege
90  USE lib_mpp
91 #endif
92  IMPLICIT NONE
93 !
94  CHARACTER(*), INTENT(in) :: &
95  omsg
96  TYPE(t_dom), DIMENSION(nx,ny), INTENT(in) :: &
97  tpdom
98  TYPE(t_sit), DIMENSION(nt,nx,ny), INTENT(in) :: &
99  tpsit
100 !
101  LOGICAL, DIMENSION(nx,ny) :: &
102  ghnorth,ghsouth
103  REAL :: &
104  zlatn0,zlats0,zehn,zehs,zshn,zshs,zvhn,zvhs
105  REAL, DIMENSION(nx,ny) :: &
106  zfsit,zhsiw,zsrf
107 !
108 !
109 !
110 ! 1. Initializations
111 ! ==================
112 !
113  IF ( nprinto>=2 ) THEN
114 !
115 ! .. Print message
116 !
117  IF (lwg) THEN
118  WRITE(noutlu,*) ' '
119  WRITE(noutlu,*) ' **** gltools_chkglo ****'
120  WRITE(noutlu,*) omsg
121  ENDIF
122 !
123 ! .. Northern and southern boundaries (latitude)
124 !
125  zlatn0 = 0. ! 40.*pi/180.
126  zlats0 = 0. ! -40.*pi/180.
127 !
128 ! .. Masked surface
129 !
130  zsrf(:,:) = tpdom(:,:)%srf*float(tpdom(:,:)%imk)
131 !
132 ! .. Compute the total concentration of sea ice and its average thickness
133 ! field.
134 !
135  zfsit(:,:) = sum( tpsit(:,:,:)%fsi, dim=1 )*float( tpdom(:,:)%tmk )
136 !
137  zhsiw(:,:) = sum( tpsit(:,:,:)%fsi*tpsit(:,:,:)%hsi, dim=1 )* &
138  float( tpdom(:,:)%tmk )
139 !
140 ! .. Define the northern and southern domains
141 !
142  ghnorth(:,:) = .false.
143  ghsouth(:,:) = .false.
144 !
145  WHERE( tpdom(:,:)%lat>zlatn0 )
146  ghnorth(:,:) = .true.
147  ENDWHERE
148 !
149  WHERE( tpdom(:,:)%lat<zlats0 )
150  ghsouth(:,:) = .true.
151  ENDWHERE
152 !
153 !
154 !
155 ! 2. Compute global quantities (north and south)
156 ! ==============================================
157 !
158 ! Note that the following formulations are correct. Since tpdom%srf is zero for
159 ! ghost points, the SUMs imply that ghost points are not taken into account.
160 ! Fields are integrated over every subdomain, then a mpp_sum allows to
161 ! add the results of all these integrations to get a global value.
162 !
163 !
164 ! 2.1. Sea ice extent (in millions of km2)
165 ! ----------------------------------------
166 !
167  zehn = sum( zsrf(:,:), mask=(ghnorth(:,:).AND.zfsit(:,:)>xfsic) ) / 1.e+12
168  zehs = sum( zsrf(:,:), mask=(ghsouth(:,:).AND.zfsit(:,:)>xfsic) ) / 1.e+12
169 !
170 !
171 ! 2.2. Sea ice area (in millions of km2)
172 ! --------------------------------------
173 !
174  zshn = sum( zsrf(:,:)*zfsit(:,:), mask=ghnorth(:,:) ) / 1.e+12
175  zshs = sum( zsrf(:,:)*zfsit(:,:), mask=ghsouth(:,:) ) / 1.e+12
176 !
177 !
178 ! 2.3. Sea ice volume
179 ! -------------------
180 !
181  zvhn = sum( zsrf(:,:)*zhsiw(:,:), mask=ghnorth(:,:) ) / 1.e+12
182  zvhs = sum( zsrf(:,:)*zhsiw(:,:), mask=ghsouth(:,:) ) / 1.e+12
183 !
184 !
185 !
186 ! 3. Write totals to glt_output file
187 ! ==============================
188 !
189 #if ! defined in_arpege
190  CALL mpp_sum( zehn )
191  CALL mpp_sum( zehs )
192  CALL mpp_sum( zshn )
193  CALL mpp_sum( zshs )
194  CALL mpp_sum( zvhn )
195  CALL mpp_sum( zvhs )
196 !
197  IF (lwg) THEN
198  WRITE(noutlu,*) ' North South'
199  WRITE(noutlu,1000) zshn,zshs
200  WRITE(noutlu,1100) zehn,zehs
201  WRITE(noutlu,1200) zvhn,zvhs
202  ENDIF
203 #endif
204 !
205  ENDIF
206 !
207 !
208 !
209 ! 4. Formats
210 ! ==========
211 !
212 1000 FORMAT( 5x,"Ice surface (SISH.SIG)",2(4x,f9.5) )
213 1100 FORMAT( 5x,"Ice extent (SIEH.SIG)",2(4x,f9.5) )
214 1200 FORMAT( 5x,"Ice volume (SIVH.SIG)",2(4x,f9.5) )
215 !
216 END SUBROUTINE gltools_chkglo
217 
218 ! ----------------------- END SUBROUTINE gltools_chkglo -------------------------
219 ! -----------------------------------------------------------------------
subroutine gltools_chkglo(omsg, tpdom, tpsit)