source: LMDZ6/trunk/libf/dyn3d/caladvtrac.f90 @ 5254

Last change on this file since 5254 was 5246, checked in by abarral, 29 hours ago

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.2 KB
Line 
1!
2! $Id: caladvtrac.f90 5246 2024-10-21 12:58:45Z abarral $
3!
4!
5!
6      SUBROUTINE caladvtrac(q,pbaru,pbarv , &
7              p ,masse, dq ,  teta, &
8              flxw, pk)
9  !
10  USE infotrac, ONLY : nqtot
11  USE control_mod, ONLY : iapp_tracvl,planet_type
12  USE comconst_mod, ONLY: dtvr
13
14  IMPLICIT NONE
15  !
16  ! Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron
17  !
18  ! F.Codron (10/99) : ajout humidite specifique pour eau vapeur
19  !=======================================================================
20  !
21  !   Shema de  Van Leer
22  !
23  !=======================================================================
24
25
26  include "dimensions.h"
27  include "paramet.h"
28
29  !   Arguments:
30  !   ----------
31  REAL :: pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm),masse(ip1jmp1,llm)
32  REAL :: p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqtot)
33  real :: dq(ip1jmp1,llm,nqtot)
34  REAL :: teta( ip1jmp1,llm),pk( ip1jmp1,llm)
35  REAL               :: flxw(ip1jmp1,llm)
36
37  !  ..................................................................
38  !
39  !  .. dq n'est utilise et dimensionne que pour l'eau  vapeur et liqu.
40  !
41  !  ..................................................................
42  !
43  !   Local:
44  !   ------
45
46  EXTERNAL  advtrac,minmaxq, qminimum
47  INTEGER :: ij,l, iq, iapptrac
48  REAL :: finmasse(ip1jmp1,llm), dtvrtrac
49
50  !c
51  !
52  ! Earth-specific stuff for the first 2 tracers (water)
53  if (planet_type.eq."earth") then
54  ! initialisation
55  ! CRisi: il faut gérer tous les traceurs si on veut pouvoir faire des
56  ! isotopes
57     ! dq(:,:,1:2)=q(:,:,1:2)
58    dq(:,:,1:nqtot)=q(:,:,1:nqtot)
59
60  !  test des valeurs minmax
61  !c        CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur (a) ')
62  !c        CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide(a) ')
63  endif ! of if (planet_type.eq."earth")
64  !   advection
65
66    CALL advtrac( pbaru,pbarv, &
67          p,  masse,q,iapptrac, teta, &
68          flxw, pk)
69
70  !
71
72  IF( iapptrac.EQ.iapp_tracvl ) THEN
73    if (planet_type.eq."earth") then
74  ! Earth-specific treatment for the first 2 tracers (water)
75  !
76  !c          CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur     ')
77  !c          CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide    ')
78
79  !c     ....  Calcul  de deltap  qu'on stocke dans finmasse   ...
80  !
81      DO l = 1, llm
82       DO ij = 1, ip1jmp1
83         finmasse(ij,l) =  p(ij,l) - p(ij,l+1)
84       ENDDO
85      ENDDO
86
87      ! !write(*,*) 'caladvtrac 87'
88      CALL qminimum( q, nqtot, finmasse )
89      ! !write(*,*) 'caladvtrac 89'
90
91      CALL SCOPY   ( ip1jmp1*llm, masse, 1, finmasse,       1 )
92      CALL filtreg ( finmasse ,  jjp1,  llm, -2, 2, .TRUE., 1 )
93  !
94  !   *****  Calcul de dq pour l'eau , pour le passer a la physique ******
95  !   ********************************************************************
96  !
97      dtvrtrac = iapp_tracvl * dtvr
98  !
99       DO iq = 1 , nqtot
100        DO l = 1 , llm
101         DO ij = 1,ip1jmp1
102         dq(ij,l,iq) = ( q(ij,l,iq) - dq(ij,l,iq) ) * finmasse(ij,l) &
103               /  dtvrtrac
104         ENDDO
105        ENDDO
106       ENDDO
107  !
108    endif ! of if (planet_type.eq."earth")
109  ELSE
110    if (planet_type.eq."earth") then
111  ! Earth-specific treatment for the first 2 tracers (water)
112      dq(:,:,1:nqtot)=0.
113    endif ! of if (planet_type.eq."earth")
114  ENDIF ! of IF( iapptrac.EQ.iapp_tracvl )
115
116END SUBROUTINE caladvtrac
117
118
Note: See TracBrowser for help on using the repository browser.