Ignore:
Timestamp:
Oct 21, 2024, 2:58:45 PM (23 hours ago)
Author:
abarral
Message:

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

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3d/caladvtrac.f90

    r5245 r5246  
    22! $Id$
    33!
    4 c
    5 c
    6             SUBROUTINE caladvtrac(q,pbaru,pbarv ,
    7      *                   p ,masse, dq ,  teta,
    8      *                   flxw, pk)
    9 c
    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 c
    16 c     Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron 
    17 c
    18 c    F.Codron (10/99) : ajout humidite specifique pour eau vapeur
    19 c=======================================================================
    20 c
    21 c       Shema de  Van Leer
    22 c
    23 c=======================================================================
     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  !=======================================================================
    2424
    2525
    26       include "dimensions.h"
    27       include "paramet.h"
     26  include "dimensions.h"
     27  include "paramet.h"
    2828
    29 c   Arguments:
    30 c   ----------
    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)
     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)
    3636
    37 c  ..................................................................
    38 c
    39 c  .. dq n'est utilise et dimensionne que pour l'eau  vapeur et liqu.
    40 c
    41 c  ..................................................................
    42 c
    43 c   Local:
    44 c   ------
     37  !  ..................................................................
     38  !
     39  !  .. dq n'est utilise et dimensionne que pour l'eau  vapeur et liqu.
     40  !
     41  !  ..................................................................
     42  !
     43  !   Local:
     44  !   ------
    4545
    46       EXTERNAL  advtrac,minmaxq, qminimum
    47       INTEGER ij,l, iq, iapptrac
    48       REAL finmasse(ip1jmp1,llm), dtvrtrac
     46  EXTERNAL  advtrac,minmaxq, qminimum
     47  INTEGER :: ij,l, iq, iapptrac
     48  REAL :: finmasse(ip1jmp1,llm), dtvrtrac
    4949
    50 cc
    51 c
    52 ! Earth-specific stuff for the first 2 tracers (water)
    53       if (planet_type.eq."earth") then
    54 C 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 c  test des valeurs minmax
    61 cc        CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur (a) ')
    62 cc        CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide(a) ')
    63       endif ! of if (planet_type.eq."earth")
    64 c   advection
     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)
    6559
    66         CALL advtrac( pbaru,pbarv,
    67      *       p,  masse,q,iapptrac, teta,
    68      .       flxw, pk)
     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
    6965
    70 c
     66    CALL advtrac( pbaru,pbarv, &
     67          p,  masse,q,iapptrac, teta, &
     68          flxw, pk)
    7169
    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 c
    76 cc          CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur     ')
    77 cc          CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide    ')
     70  !
    7871
    79 cc     ....  Calcul  de deltap  qu'on stocke dans finmasse   ...
    80 c
    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
     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    ')
    8678
    87           !write(*,*) 'caladvtrac 87'
    88           CALL qminimum( q, nqtot, finmasse )
    89           !write(*,*) 'caladvtrac 89'
     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
    9086
    91           CALL SCOPY   ( ip1jmp1*llm, masse, 1, finmasse,       1 )
    92           CALL filtreg ( finmasse ,  jjp1,  llm, -2, 2, .TRUE., 1 )
    93 c
    94 c   *****  Calcul de dq pour l'eau , pour le passer a la physique ******
    95 c   ********************************************************************
    96 c
    97           dtvrtrac = iapp_tracvl * dtvr
    98 c
    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 c
    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 )
     87      ! !write(*,*) 'caladvtrac 87'
     88      CALL qminimum( q, nqtot, finmasse )
     89      ! !write(*,*) 'caladvtrac 89'
    11590
    116       END
     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
    117117
    118118
Note: See TracChangeset for help on using the changeset viewer.