source: LMDZ4/branches/LMDZ4-dev-20091210/libf/dyn3d/fluxstokenc.F

Last change on this file was 1222, checked in by Ehouarn Millour, 16 years ago

Changes and cleanups to enable compiling without physics
and without ioipsl.

IOIPSL related cleanups:

  • bibio/writehist.F encapsulate the routine (which needs IOIPSL to function)

with #ifdef IOIPSL flag.

  • dyn3d/abort_gcm.F, dyn3dpar/abort_gcm.F and dyn3dpar/getparam.F90: use ioipsl_getincom module when not compiling with IOIPSL library, in order to always be able to use getin() routine.
  • removed unused "use IOIPSL" in dyn3dpar/guide_p_mod.F90
  • calendar related issue: Initialize day_ref and annee_ref in iniacademic.F (i.e. when they are not read from start.nc file)

Earth-specific programs/routines/modules:
create_etat0.F, fluxstokenc.F, limit_netcdf.F, startvar.F
(versions in dyn3d and dyn3dpar)
These routines and modules, which by design and porpose are made to function with
Earth physics are encapsulated with #CPP_EARTH cpp flag.

Earth-specific instructions:

  • calls to qminimum (specific treatment of first 2 tracers, i.e. water) in dyn3d/caladvtrac.F, dyn3d/integrd.F, dyn3dpar/caladvtrac_p.F, dyn3dpar/integrd_p.F only if (planet_type == 'earth')

Interaction with parallel physics:

  • routine dyn3dpar/parallel.F90 uses "surface_data" module (which is in the physics ...) to know value of "type_ocean" . Encapsulated that with #ifdef CPP_EARTH and set to a default type_ocean="dummy" otherwise.
  • So far, only Earth physics are parallelized, so all the interaction between parallel dynamics and parallel physics are encapsulated with #ifdef CCP_EARTH (this way we can run parallel without any physics). The (dyn3dpar) routines which contains such interaction are: bands.F90, gr_dyn_fi_p.F, gr_fi_dyn_p.F, mod_interface_dyn_phys.F90 This should later (when improving dyn/phys interface) be encapsulated with a more general and appropriate #ifdef CPP_PHYS cpp flag.

I checked that these changes do not alter results (on the simple
32x24x11 bench) on Ciclad (seq & mpi), Brodie (seq, mpi & omp) and
Vargas (seq, mpi & omp).

EM
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.2 KB
Line 
1!
2! $Id: fluxstokenc.F 1222 2009-08-07 11:48:33Z aclsce $
3!
4      SUBROUTINE fluxstokenc(pbaru,pbarv,masse,teta,phi,phis,
5     . time_step,itau )
6#ifdef CPP_EARTH
7! This routine is designed to work for Earth and with ioipsl
8
9       USE IOIPSL
10c
11c     Auteur :  F. Hourdin
12c
13c
14ccc   ..   Modif. P. Le Van  ( 20/12/97 )  ...
15c
16      IMPLICIT NONE
17c
18#include "dimensions.h"
19#include "paramet.h"
20#include "comconst.h"
21#include "comvert.h"
22#include "comgeom.h"
23#include "tracstoke.h"
24#include "temps.h"
25#include "iniprint.h"
26
27      REAL time_step,t_wrt, t_ops
28      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
29      REAL masse(ip1jmp1,llm),teta(ip1jmp1,llm),phi(ip1jmp1,llm)
30      REAL phis(ip1jmp1)
31
32      REAL pbaruc(ip1jmp1,llm),pbarvc(ip1jm,llm)
33      REAL massem(ip1jmp1,llm),tetac(ip1jmp1,llm),phic(ip1jmp1,llm)
34
35      REAL pbarug(ip1jmp1,llm),pbarvg(iip1,jjm,llm),wg(ip1jmp1,llm)
36
37      REAL pbarvst(iip1,jjp1,llm),zistdyn
38        real dtcum
39
40      INTEGER iadvtr,ndex(1)
41      integer nscal
42      real tst(1),ist(1),istp(1)
43      INTEGER ij,l,irec,i,j,itau
44      INTEGER, SAVE :: fluxid, fluxvid,fluxdid
45 
46      SAVE iadvtr, massem,pbaruc,pbarvc,irec
47      SAVE phic,tetac
48      logical first
49      save first
50      data first/.true./
51      DATA iadvtr/0/
52
53
54c AC initialisations
55      pbarug(:,:)   = 0.
56      pbarvg(:,:,:) = 0.
57      wg(:,:)       = 0.
58     
59
60      if(first) then
61
62        CALL initfluxsto( 'fluxstoke',
63     .  time_step,istdyn* time_step,istdyn* time_step,
64     .  fluxid,fluxvid,fluxdid)
65       
66        ndex(1) = 0
67        call histwrite(fluxid, 'phis', 1, phis, iip1*jjp1, ndex)
68        call histwrite(fluxid, 'aire', 1, aire, iip1*jjp1, ndex)
69       
70        ndex(1) = 0
71        nscal = 1
72        tst(1) = time_step
73        call histwrite(fluxdid, 'dtvr', 1, tst, nscal, ndex)
74        ist(1)=istdyn
75        call histwrite(fluxdid, 'istdyn', 1, ist, nscal, ndex)
76        istp(1)= istphy
77        call histwrite(fluxdid, 'istphy', 1, istp, nscal, ndex)
78       
79        first = .false.
80
81      endif
82
83
84      IF(iadvtr.EQ.0) THEN
85         CALL initial0(ijp1llm,phic)
86         CALL initial0(ijp1llm,tetac)
87         CALL initial0(ijp1llm,pbaruc)
88         CALL initial0(ijmllm,pbarvc)
89      ENDIF
90
91c   accumulation des flux de masse horizontaux
92      DO l=1,llm
93         DO ij = 1,ip1jmp1
94            pbaruc(ij,l) = pbaruc(ij,l) + pbaru(ij,l)
95            tetac(ij,l) = tetac(ij,l) + teta(ij,l)
96            phic(ij,l) = phic(ij,l) + phi(ij,l)
97         ENDDO
98         DO ij = 1,ip1jm
99            pbarvc(ij,l) = pbarvc(ij,l) + pbarv(ij,l)
100         ENDDO
101      ENDDO
102
103c   selection de la masse instantannee des mailles avant le transport.
104      IF(iadvtr.EQ.0) THEN
105         CALL SCOPY(ip1jmp1*llm,masse,1,massem,1)
106      ENDIF
107
108      iadvtr   = iadvtr+1
109
110
111c   Test pour savoir si on advecte a ce pas de temps
112      IF ( iadvtr.EQ.istdyn ) THEN
113c    normalisation
114      DO l=1,llm
115         DO ij = 1,ip1jmp1
116            pbaruc(ij,l) = pbaruc(ij,l)/float(istdyn)
117            tetac(ij,l) = tetac(ij,l)/float(istdyn)
118            phic(ij,l) = phic(ij,l)/float(istdyn)
119         ENDDO
120         DO ij = 1,ip1jm
121            pbarvc(ij,l) = pbarvc(ij,l)/float(istdyn)
122         ENDDO
123      ENDDO
124
125c   traitement des flux de masse avant advection.
126c     1. calcul de w
127c     2. groupement des mailles pres du pole.
128
129        CALL groupe( massem, pbaruc,pbarvc, pbarug,pbarvg,wg )
130
131        do l=1,llm
132           do j=1,jjm
133              do i=1,iip1
134                 pbarvst(i,j,l)=pbarvg(i,j,l)
135              enddo
136           enddo
137           do i=1,iip1
138              pbarvst(i,jjp1,l)=0.
139           enddo
140        enddo
141
142         iadvtr=0
143        Print*,'ITAU auqel on stoke les fluxmasses',itau
144       
145        call histwrite(fluxid, 'masse', itau, massem,
146     .               iip1*jjp1*llm, ndex)
147       
148        call histwrite(fluxid, 'pbaru', itau, pbarug,
149     .               iip1*jjp1*llm, ndex)
150       
151        call histwrite(fluxvid, 'pbarv', itau, pbarvg,
152     .               iip1*jjm*llm, ndex)
153       
154        call histwrite(fluxid, 'w' ,itau, wg,
155     .             iip1*jjp1*llm, ndex)
156       
157        call histwrite(fluxid, 'teta' ,itau, tetac,
158     .             iip1*jjp1*llm, ndex)
159       
160        call histwrite(fluxid, 'phi' ,itau, phic,
161     .             iip1*jjp1*llm, ndex)
162       
163C
164
165      ENDIF ! if iadvtr.EQ.istdyn
166
167#else
168      write(lunout,*)
169     & 'fluxstokenc: Needs Earth physics (and ioipsl) to function'
170#endif
171! of #ifdef CPP_EARTH
172      RETURN
173      END
Note: See TracBrowser for help on using the repository browser.