GCC Code Coverage Report

Directory: ./
File: dyn/caldyn.f
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 28 29 96.6%
Branches: 13 14 92.9%
Line Branch Exec Source
1 !
2 ! $Id: caldyn.F 2600 2016-07-23 05:45:38Z emillour $
3 !
4 2881 SUBROUTINE caldyn
5 $ (itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
6 $ phi,conser,du,dv,dteta,dp,w,pbaru,pbarv,time )
7
8
9 USE comvert_mod, ONLY: ap, bp
10
11 IMPLICIT NONE
12
13 !=======================================================================
14 !
15 ! Auteur : P. Le Van
16 !
17 ! Objet:
18 ! ------
19 !
20 ! Calcul des tendances dynamiques.
21 !
22 ! Modif 04/93 F.Forget
23 !=======================================================================
24
25 !-----------------------------------------------------------------------
26 ! 0. Declarations:
27 ! ----------------
28
29 include "dimensions.h"
30 include "paramet.h"
31 include "comgeom.h"
32
33 ! Arguments:
34 ! ----------
35
36 LOGICAL,INTENT(IN) :: conser ! triggers printing some diagnostics
37 INTEGER,INTENT(IN) :: itau ! time step index
38 REAL,INTENT(IN) :: vcov(ip1jm,llm) ! covariant meridional wind
39 REAL,INTENT(IN) :: ucov(ip1jmp1,llm) ! covariant zonal wind
40 REAL,INTENT(IN) :: teta(ip1jmp1,llm) ! potential temperature
41 REAL,INTENT(IN) :: ps(ip1jmp1) ! surface pressure
42 REAL,INTENT(IN) :: phis(ip1jmp1) ! geopotential at the surface
43 REAL,INTENT(IN) :: pk(ip1jmp1,llm) ! Exner at mid-layer
44 REAL,INTENT(IN) :: pkf(ip1jmp1,llm) ! filtered Exner
45 REAL,INTENT(IN) :: phi(ip1jmp1,llm) ! geopotential
46 REAL,INTENT(OUT) :: masse(ip1jmp1,llm) ! air mass
47 REAL,INTENT(OUT) :: dv(ip1jm,llm) ! tendency on vcov
48 REAL,INTENT(OUT) :: du(ip1jmp1,llm) ! tendency on ucov
49 REAL,INTENT(OUT) :: dteta(ip1jmp1,llm) ! tenddency on teta
50 REAL,INTENT(OUT) :: dp(ip1jmp1) ! tendency on ps
51 REAL,INTENT(OUT) :: w(ip1jmp1,llm) ! vertical velocity
52 REAL,INTENT(OUT) :: pbaru(ip1jmp1,llm) ! mass flux in the zonal direction
53 REAL,INTENT(OUT) :: pbarv(ip1jm,llm) ! mass flux in the meridional direction
54 REAL,INTENT(IN) :: time ! current time
55
56 ! Local:
57 ! ------
58
59 REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
60 REAL ang(ip1jmp1,llm),p(ip1jmp1,llmp1)
61 REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),psexbarxy(ip1jm)
62 REAL vorpot(ip1jm,llm)
63 REAL ecin(ip1jmp1,llm),convm(ip1jmp1,llm)
64 REAL bern(ip1jmp1,llm)
65 REAL massebxy(ip1jm,llm)
66
67
68 INTEGER ij,l
69
70 !-----------------------------------------------------------------------
71 ! Compute dynamical tendencies:
72 !--------------------------------
73
74 ! compute contravariant winds ucont() and vcont
75 2881 CALL covcont ( llm , ucov , vcov , ucont, vcont )
76 ! compute pressure p()
77 2881 CALL pression ( ip1jmp1, ap , bp , ps , p )
78 ! compute psexbarxy() XY-area weighted-averaged surface pressure (what for?)
79 2881 CALL psextbar ( ps , psexbarxy )
80 ! compute mass in each atmospheric mesh: masse()
81 2881 CALL massdair ( p , masse )
82 ! compute X and Y-averages of mass, massebx() and masseby()
83 2881 CALL massbar ( masse, massebx , masseby )
84 ! compute XY-average of mass, massebxy()
85 2881 call massbarxy( masse, massebxy )
86 ! compute mass fluxes pbaru() and pbarv()
87 2881 CALL flumass ( massebx, masseby , vcont, ucont ,pbaru, pbarv )
88 ! compute dteta() , horizontal converging flux of theta
89 2881 CALL dteta1 ( teta , pbaru , pbarv, dteta )
90 ! compute convm(), horizontal converging flux of mass
91 2881 CALL convmas ( pbaru, pbarv , convm )
92
93 ! compute pressure variation due to mass convergence
94
2/2
✓ Branch 0 taken 3137409 times.
✓ Branch 1 taken 2881 times.
 3140290 DO ij =1, ip1jmp1
95 3140290 dp( ij ) = convm( ij,1 ) / airesurg( ij )
96 ENDDO
97
98 ! compute vertical velocity w()
99 2881 CALL vitvert ( convm , w )
100 ! compute potential vorticity vorpot()
101 2881 CALL tourpot ( vcov , ucov , massebxy , vorpot )
102 ! compute rotation induced du() and dv()
103 2881 CALL dudv1 ( vorpot , pbaru , pbarv , du , dv )
104 ! compute kinetic energy ecin()
105 2881 CALL enercin ( vcov , ucov , vcont , ucont , ecin )
106 ! compute Bernouilli function bern()
107 2881 CALL bernoui ( ip1jmp1, llm , phi , ecin , bern )
108 ! compute and add du() and dv() contributions from Bernouilli and pressure
109 2881 CALL dudv2 ( teta , pkf , bern , du , dv )
110
111
112
2/2
✓ Branch 0 taken 112359 times.
✓ Branch 1 taken 2881 times.
 115240 DO l=1,llm
113
2/2
✓ Branch 0 taken 122358951 times.
✓ Branch 1 taken 112359 times.
 122474191 DO ij=1,ip1jmp1
114 122471310 ang(ij,l) = ucov(ij,l) + constang(ij)
115 ENDDO
116 ENDDO
117
118 ! compute vertical advection contributions to du(), dv() and dteta()
119 2881 CALL advect( ang, vcov, teta, w, massebx, masseby, du, dv,dteta )
120
121 ! WARNING probleme de peridocite de dv sur les PC/1. Pb d'arrondi
122 ! probablement. Observe sur le code compile avec pgf90 3.0-1
123
124
2/2
✓ Branch 0 taken 112359 times.
✓ Branch 1 taken 2881 times.
 115240 DO l = 1, llm
125
2/2
✓ Branch 0 taken 3483129 times.
✓ Branch 1 taken 112359 times.
 3598369 DO ij = 1, ip1jm, iip1
126
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 3595488 times.
 3707847 IF( dv(ij,l).NE.dv(ij+iim,l) ) THEN
127 ! PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov',
128 ! , ' dans caldyn'
129 ! PRINT *,' l, ij = ', l, ij, ij+iim,dv(ij+iim,l),dv(ij,l)
130 ✗ dv(ij+iim,l) = dv(ij,l)
131 ENDIF
132 ENDDO
133 ENDDO
134
135 !-----------------------------------------------------------------------
136 ! Output some control variables:
137 !---------------------------------
138
139
2/2
✓ Branch 0 taken 81 times.
✓ Branch 1 taken 2800 times.
 2881 IF( conser ) THEN
140 CALL sortvarc
141 81 & ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov )
142 ENDIF
143
144 2881 END
145