source: LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/sortvarc0.F @ 2529

Last change on this file since 2529 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: 3.7 KB
Line 
1!
2! $Id: sortvarc0.F 1299 2010-01-20 14:27:21Z oboucher $
3!
4      SUBROUTINE sortvarc0
5     $(itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time ,
6     $ vcov)
7      IMPLICIT NONE
8
9c=======================================================================
10c
11c   Auteur:    P. Le Van
12c   -------
13c
14c   Objet:
15c   ------
16c
17c   sortie des variables de controle
18c
19c=======================================================================
20c-----------------------------------------------------------------------
21c   Declarations:
22c   -------------
23
24#include "dimensions.h"
25#include "paramet.h"
26#include "comconst.h"
27#include "comvert.h"
28#include "comgeom.h"
29#include "ener.h"
30#include "logic.h"
31#include "temps.h"
32
33c   Arguments:
34c   ----------
35
36      INTEGER itau
37      REAL ucov(ip1jmp1,llm),teta(ip1jmp1,llm),masse(ip1jmp1,llm)
38      REAL vcov(ip1jm,llm)
39      REAL ps(ip1jmp1),phis(ip1jmp1)
40      REAL vorpot(ip1jm,llm)
41      REAL phi(ip1jmp1,llm),bern(ip1jmp1,llm)
42      REAL dp(ip1jmp1)
43      REAL time
44      REAL pk(ip1jmp1,llm)
45
46c   Local:
47c   ------
48
49      REAL vor(ip1jm),bernf(ip1jmp1,llm),ztotl(llm)
50      REAL etotl(llm),stotl(llm),rmsvl(llm),angl(llm),ge(ip1jmp1)
51      REAL cosphi(ip1jm),omegcosp(ip1jm)
52      REAL dtvrs1j,rjour,heure,radsg,radomeg
53      REAL rday, massebxy(ip1jm,llm)
54      INTEGER  l, ij, imjmp1
55
56      REAL       SSUM
57      integer  ismin,ismax
58
59c-----------------------------------------------------------------------
60
61       dtvrs1j   = dtvr/daysec
62       rjour     = REAL( INT( itau * dtvrs1j ))
63       heure     = ( itau*dtvrs1j-rjour ) * 24.
64       imjmp1    = iim * jjp1
65       IF(ABS(heure - 24.).LE.0.0001 ) heure = 0.
66c
67       CALL massbarxy ( masse, massebxy )
68
69c   .....  Calcul  de  rmsdpdt  .....
70
71       ge=dp*dp
72
73       rmsdpdt = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
74c
75       rmsdpdt = daysec* 1.e-2 * SQRT(rmsdpdt/imjmp1)
76
77       CALL SCOPY( ijp1llm,bern,1,bernf,1 )
78       CALL filtreg(bernf,jjp1,llm,-2,2,.TRUE.,1)
79
80c   .....  Calcul du moment  angulaire   .....
81
82       radsg    = rad /g
83       radomeg  = rad * omeg
84c
85       DO ij=iip2,ip1jm
86          cosphi( ij ) = COS(rlatu((ij-1)/iip1+1))
87          omegcosp(ij) = radomeg   * cosphi(ij)
88       ENDDO
89
90c  ...  Calcul  de l'energie,de l'enstrophie,de l'entropie et de rmsv  .
91
92       DO l=1,llm
93          DO ij = 1,ip1jm
94             vor(ij)=vorpot(ij,l)*vorpot(ij,l)*massebxy(ij,l)
95          ENDDO
96          ztotl(l)=(SSUM(ip1jm,vor,1)-SSUM(jjm,vor,iip1))
97
98          DO ij = 1,ip1jmp1
99             ge(ij)= masse(ij,l)*(phis(ij)+teta(ij,l)*pk(ij,l)  +
100     s        bernf(ij,l)-phi(ij,l))
101          ENDDO
102          etotl(l) = SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
103
104          DO   ij   = 1, ip1jmp1
105             ge(ij) = masse(ij,l)*teta(ij,l)
106          ENDDO
107          stotl(l)= SSUM(ip1jmp1,ge,1) - SSUM(jjp1,ge,iip1)
108
109          DO ij=1,ip1jmp1
110             ge(ij)=masse(ij,l)*AMAX1(bernf(ij,l)-phi(ij,l),0.)
111          ENDDO
112          rmsvl(l)=2.*(SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1))
113
114          DO ij =iip2,ip1jm
115             ge(ij)=(ucov(ij,l)/cu(ij)+omegcosp(ij))*masse(ij,l) *
116     *               cosphi(ij)
117          ENDDO
118          angl(l) = radsg *
119     s    (SSUM(ip1jm-iip1,ge(iip2),1)-SSUM(jjm-1,ge(iip2),iip1))
120      ENDDO
121
122          DO ij=1,ip1jmp1
123            ge(ij)= ps(ij)*aire(ij)
124          ENDDO
125      ptot0  = SSUM(ip1jmp1,ge,1)-SSUM(jjp1,ge,iip1)
126      etot0  = SSUM(     llm, etotl, 1 )
127      ztot0  = SSUM(     llm, ztotl, 1 )
128      stot0  = SSUM(     llm, stotl, 1 )
129      rmsv   = SSUM(     llm, rmsvl, 1 )
130      ang0   = SSUM(     llm,  angl, 1 )
131
132      rday = REAL(INT (time ))
133c
134      PRINT 3500, itau, rday, heure, time
135      PRINT *, ptot0,etot0,ztot0,stot0,ang0
136
1373500   FORMAT(10("*"),4x,'pas',i7,5x,'jour',f5.0,'heure',f5.1,4x
138     *   ,'date',f10.5,4x,10("*"))
139      RETURN
140      END
141
Note: See TracBrowser for help on using the repository browser.