source: LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/inidissip.F @ 1366

Last change on this file since 1366 was 1299, checked in by Laurent Fairhead, 15 years ago

Nettoyage general pour se rapprocher des normes et éviter des erreurs a la
compilation:

  • tous les FLOAT() sont remplacés par des REAL()
  • tous les STOP dans phylmd sont remplacés par des appels à abort_gcm
  • le common control défini dans le fichier control.h est remplacé par le module control_mod pour éviter des messages sur l'alignement des variables dans les déclarations
  • des $Header$ remplacés par des $Id$ pour svn

Quelques remplacements à faire ont pu m'échapper

General cleanup of the code to try and adhere to norms and to prevent some
compilation errors:

  • all FLOAT() instructions have been replaced by REAL() instructions
  • all STOP instructions in phylmd have been replaced by calls to abort_gcm
  • the common block control defined in the control.h file has been replaced by the control_mod to prevent compilation warnings on the alignement of declared variables
  • $Header$ replaced by $Id$ for svn

Some changes which should have been made might have escaped me
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.0 KB
Line 
1!
2! $Id: inidissip.F 1299 2010-01-20 14:27:21Z emillour $
3!
4      SUBROUTINE inidissip ( lstardis,nitergdiv,nitergrot,niterh  ,
5     *                       tetagdiv,tetagrot,tetatemp             )
6c=======================================================================
7c   initialisation de la dissipation horizontale
8c=======================================================================
9c-----------------------------------------------------------------------
10c   declarations:
11c   -------------
12
13      USE control_mod
14
15      IMPLICIT NONE
16#include "dimensions.h"
17#include "paramet.h"
18#include "comdissipn.h"
19#include "comconst.h"
20#include "comvert.h"
21#include "logic.h"
22
23      LOGICAL lstardis
24      INTEGER nitergdiv,nitergrot,niterh
25      REAL    tetagdiv,tetagrot,tetatemp
26      REAL fact,zvert(llm),zz
27      REAL zh(ip1jmp1),zu(ip1jmp1),zv(ip1jm),deltap(ip1jmp1,llm)
28      REAL ullm,vllm,umin,vmin,zhmin,zhmax
29      REAL zllm,z1llm
30
31      INTEGER l,ij,idum,ii
32      REAL tetamin
33      REAL pseudoz
34
35      REAL ran1
36
37
38c-----------------------------------------------------------------------
39c
40c   calcul des valeurs propres des operateurs par methode iterrative:
41c   -----------------------------------------------------------------
42
43      crot     = -1.
44      cdivu    = -1.
45      cdivh    = -1.
46
47c   calcul de la valeur propre de divgrad:
48c   --------------------------------------
49      idum = 0
50      DO l = 1, llm
51       DO ij = 1, ip1jmp1
52        deltap(ij,l) = 1.
53       ENDDO
54      ENDDO
55
56      idum  = -1
57      zh(1) = RAN1(idum)-.5
58      idum  = 0
59      DO ij = 2, ip1jmp1
60        zh(ij) = RAN1(idum) -.5
61      ENDDO
62
63      CALL filtreg (zh,jjp1,1,2,1,.TRUE.,1)
64
65      CALL minmax(iip1*jjp1,zh,zhmin,zhmax )
66
67      IF ( zhmin .GE. zhmax  )     THEN
68         PRINT*,'  Inidissip  zh min max  ',zhmin,zhmax
69         STOP'probleme generateur alleatoire dans inidissip'
70      ENDIF
71
72      zllm = ABS( zhmax )
73      DO l = 1,50
74         IF(lstardis) THEN
75            CALL divgrad2(1,zh,deltap,niterh,zh)
76         ELSE
77            CALL divgrad (1,zh,niterh,zh)
78         ENDIF
79
80        CALL minmax(iip1*jjp1,zh,zhmin,zhmax )
81
82         zllm  = ABS( zhmax )
83         z1llm = 1./zllm
84         DO ij = 1,ip1jmp1
85            zh(ij) = zh(ij)* z1llm
86         ENDDO
87      ENDDO
88
89      IF(lstardis) THEN
90         cdivh = 1./ zllm
91      ELSE
92         cdivh = zllm ** ( -1./niterh )
93      ENDIF
94
95c   calcul des valeurs propres de gradiv (ii =1) et  nxgrarot(ii=2)
96c   -----------------------------------------------------------------
97      print*,'calcul des valeurs propres'
98
99      DO  20  ii = 1, 2
100c
101         DO ij = 1, ip1jmp1
102           zu(ij)  = RAN1(idum) -.5
103         ENDDO
104         CALL filtreg (zu,jjp1,1,2,1,.TRUE.,1)
105         DO ij = 1, ip1jm
106            zv(ij) = RAN1(idum) -.5
107         ENDDO
108         CALL filtreg (zv,jjm,1,2,1,.FALSE.,1)
109
110         CALL minmax(iip1*jjp1,zu,umin,ullm )
111         CALL minmax(iip1*jjm, zv,vmin,vllm )
112
113         ullm = ABS ( ullm )
114         vllm = ABS ( vllm )
115
116         DO  5  l = 1, 50
117            IF(ii.EQ.1) THEN
118ccccc             CALL covcont( 1,zu,zv,zu,zv )
119               IF(lstardis) THEN
120                  CALL gradiv2( 1,zu,zv,nitergdiv,zu,zv )
121               ELSE
122                  CALL gradiv ( 1,zu,zv,nitergdiv,zu,zv )
123               ENDIF
124            ELSE
125               IF(lstardis) THEN
126                  CALL nxgraro2( 1,zu,zv,nitergrot,zu,zv )
127               ELSE
128                  CALL nxgrarot( 1,zu,zv,nitergrot,zu,zv )
129               ENDIF
130            ENDIF
131
132            CALL minmax(iip1*jjp1,zu,umin,ullm )
133            CALL minmax(iip1*jjm, zv,vmin,vllm )
134
135            ullm = ABS  ( ullm )
136            vllm = ABS  ( vllm )
137
138            zllm  = MAX( ullm,vllm )
139            z1llm = 1./ zllm
140            DO ij = 1, ip1jmp1
141              zu(ij) = zu(ij)* z1llm
142            ENDDO
143            DO ij = 1, ip1jm
144               zv(ij) = zv(ij)* z1llm
145            ENDDO
146 5       CONTINUE
147
148         IF ( ii.EQ.1 ) THEN
149            IF(lstardis) THEN
150               cdivu  = 1./zllm
151            ELSE
152               cdivu  = zllm **( -1./nitergdiv )
153            ENDIF
154         ELSE
155            IF(lstardis) THEN
156               crot   = 1./ zllm
157            ELSE
158               crot   = zllm **( -1./nitergrot )
159            ENDIF
160         ENDIF
161
162 20   CONTINUE
163
164c   petit test pour les operateurs non star:
165c   ----------------------------------------
166
167c     IF(.NOT.lstardis) THEN
168         fact    = rad*24./REAL(jjm)
169         fact    = fact*fact
170         PRINT*,'coef u ', fact/cdivu, 1./cdivu
171         PRINT*,'coef r ', fact/crot , 1./crot
172         PRINT*,'coef h ', fact/cdivh, 1./cdivh
173c     ENDIF
174
175c-----------------------------------------------------------------------
176c   variation verticale du coefficient de dissipation:
177c   --------------------------------------------------
178
179      if (ok_strato .and. llm==39) then
180         do l=1,llm
181            pseudoz=8.*log(preff/presnivs(l))
182            zvert(l)=1+
183     s      (tanh((pseudoz-dissip_zref)/dissip_deltaz)+1.)/2.
184     s      *(dissip_factz-1.)
185         enddo
186      else
187         DO l=1,llm
188            zvert(l)=1.
189         ENDDO
190         fact=2.
191         DO l = 1, llm
192            zz      = 1. - preff/presnivs(l)
193            zvert(l)= fact -( fact-1.)/( 1.+zz*zz )
194         ENDDO
195      endif
196
197
198      PRINT*,'Constantes de temps de la diffusion horizontale'
199
200      tetamin =  1.e+6
201
202      DO l=1,llm
203        tetaudiv(l)   = zvert(l)/tetagdiv
204        tetaurot(l)   = zvert(l)/tetagrot
205        tetah(l)      = zvert(l)/tetatemp
206
207        IF( tetamin.GT. (1./tetaudiv(l)) ) tetamin = 1./ tetaudiv(l)
208        IF( tetamin.GT. (1./tetaurot(l)) ) tetamin = 1./ tetaurot(l)
209        IF( tetamin.GT. (1./   tetah(l)) ) tetamin = 1./    tetah(l)
210      ENDDO
211
212      PRINT *,' INIDI tetamin dtvr ',tetamin,dtvr,iperiod
213      idissip = INT( tetamin/( 2.*dtvr*iperiod) ) * iperiod
214      PRINT *,' INIDI tetamin idissip ',tetamin,idissip
215      idissip = MAX(iperiod,idissip)
216      dtdiss  = idissip * dtvr
217      PRINT *,' INIDI idissip dtdiss ',idissip,dtdiss
218
219      DO l = 1,llm
220         PRINT*,zvert(l),dtdiss*tetaudiv(l),dtdiss*tetaurot(l),
221     *                   dtdiss*tetah(l)
222      ENDDO
223
224c
225      RETURN
226      END
Note: See TracBrowser for help on using the repository browser.