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/addfi.f90

    r5245 r5246  
    22! $Id$
    33!
    4       SUBROUTINE addfi(pdt, leapf, forward,
    5      S          pucov, pvcov, pteta, pq   , pps ,
    6      S          pdufi, pdvfi, pdhfi,pdqfi, pdpfi  )
     4SUBROUTINE addfi(pdt, leapf, forward, &
     5        pucov, pvcov, pteta, pq   , pps , &
     6        pdufi, pdvfi, pdhfi,pdqfi, pdpfi  )
    77
    8       USE infotrac, ONLY : nqtot
    9       USE control_mod, ONLY : planet_type
    10       IMPLICIT NONE
    11 c
    12 c=======================================================================
    13 c
    14 c    Addition of the physical tendencies
    15 c
    16 c    Interface :
    17 c    -----------
    18 c
    19 c      Input :
    20 c      -------
    21 c      pdt                    time step of integration
    22 c      leapf                  logical
    23 c      forward                logical
    24 c      pucov(ip1jmp1,llm)     first component of the covariant velocity
    25 c      pvcov(ip1ip1jm,llm)    second component of the covariant velocity
    26 c      pteta(ip1jmp1,llm)     potential temperature
    27 c      pts(ip1jmp1,llm)       surface temperature
    28 c      pdufi(ip1jmp1,llm)     |
    29 c      pdvfi(ip1jm,llm)       |   respective
    30 c      pdhfi(ip1jmp1)         |      tendencies
    31 c      pdtsfi(ip1jmp1)        |
    32 c
    33 c      Output :
    34 c      --------
    35 c      pucov
    36 c      pvcov
    37 c      ph
    38 c      pts
    39 c
    40 c
    41 c=======================================================================
    42 c
    43 c-----------------------------------------------------------------------
    44 c
    45 c    0.  Declarations :
    46 c    ------------------
    47 c
    48       include "dimensions.h"
    49       include "paramet.h"
    50       include "comgeom.h"
    51 c
    52 c    Arguments :
    53 c    -----------
    54 c
    55       REAL,INTENT(IN) :: pdt ! time step for the integration (s)
    56 c
    57       REAL,INTENT(INOUT) :: pvcov(ip1jm,llm) ! covariant meridional wind
    58       REAL,INTENT(INOUT) :: pucov(ip1jmp1,llm) ! covariant zonal wind
    59       REAL,INTENT(INOUT) :: pteta(ip1jmp1,llm) ! potential temperature
    60       REAL,INTENT(INOUT) :: pq(ip1jmp1,llm,nqtot) ! tracers
    61       REAL,INTENT(INOUT) :: pps(ip1jmp1) ! surface pressure (Pa)
    62 c respective tendencies (.../s) to add
    63       REAL,INTENT(IN) :: pdvfi(ip1jm,llm)
    64       REAL,INTENT(IN) :: pdufi(ip1jmp1,llm)
    65       REAL,INTENT(IN) :: pdqfi(ip1jmp1,llm,nqtot)
    66       REAL,INTENT(IN) :: pdhfi(ip1jmp1,llm)
    67       REAL,INTENT(IN) :: pdpfi(ip1jmp1)
    68 c
    69       LOGICAL,INTENT(IN) :: leapf,forward ! not used
    70 c
    71 c
    72 c    Local variables :
    73 c    -----------------
    74 c
    75       REAL xpn(iim),xps(iim),tpn,tps
    76       INTEGER j,k,iq,ij
    77       REAL,PARAMETER :: qtestw = 1.0e-15
    78       REAL,PARAMETER :: qtestt = 1.0e-40
     8  USE infotrac, ONLY : nqtot
     9  USE control_mod, ONLY : planet_type
     10  IMPLICIT NONE
     11  !
     12  !=======================================================================
     13  !
     14  !    Addition of the physical tendencies
     15  !
     16  !    Interface :
     17  !    -----------
     18  !
     19  !  Input :
     20  !  -------
     21  !  pdt                    time step of integration
     22  !  leapf                  logical
     23  !  forward                logical
     24  !  pucov(ip1jmp1,llm)     first component of the covariant velocity
     25  !  pvcov(ip1ip1jm,llm)    second component of the covariant velocity
     26  !  pteta(ip1jmp1,llm)     potential temperature
     27  !  pts(ip1jmp1,llm)       surface temperature
     28  !  pdufi(ip1jmp1,llm)     |
     29  !  pdvfi(ip1jm,llm)       |   respective
     30  !  pdhfi(ip1jmp1)         |      tendencies
     31  !  pdtsfi(ip1jmp1)        |
     32  !
     33  !  Output :
     34  !  --------
     35  !  pucov
     36  !  pvcov
     37  !  ph
     38  !  pts
     39  !
     40  !
     41  !=======================================================================
     42  !
     43  !-----------------------------------------------------------------------
     44  !
     45  !    0.  Declarations :
     46  !    ------------------
     47  !
     48  include "dimensions.h"
     49  include "paramet.h"
     50  include "comgeom.h"
     51  !
     52  !    Arguments :
     53  !    -----------
     54  !
     55  REAL,INTENT(IN) :: pdt ! time step for the integration (s)
     56  !
     57  REAL,INTENT(INOUT) :: pvcov(ip1jm,llm) ! covariant meridional wind
     58  REAL,INTENT(INOUT) :: pucov(ip1jmp1,llm) ! covariant zonal wind
     59  REAL,INTENT(INOUT) :: pteta(ip1jmp1,llm) ! potential temperature
     60  REAL,INTENT(INOUT) :: pq(ip1jmp1,llm,nqtot) ! tracers
     61  REAL,INTENT(INOUT) :: pps(ip1jmp1) ! surface pressure (Pa)
     62  ! respective tendencies (.../s) to add
     63  REAL,INTENT(IN) :: pdvfi(ip1jm,llm)
     64  REAL,INTENT(IN) :: pdufi(ip1jmp1,llm)
     65  REAL,INTENT(IN) :: pdqfi(ip1jmp1,llm,nqtot)
     66  REAL,INTENT(IN) :: pdhfi(ip1jmp1,llm)
     67  REAL,INTENT(IN) :: pdpfi(ip1jmp1)
     68  !
     69  LOGICAL,INTENT(IN) :: leapf,forward ! not used
     70  !
     71  !
     72  !    Local variables :
     73  !    -----------------
     74  !
     75  REAL :: xpn(iim),xps(iim),tpn,tps
     76  INTEGER :: j,k,iq,ij
     77  REAL,PARAMETER :: qtestw = 1.0e-15
     78  REAL,PARAMETER :: qtestt = 1.0e-40
    7979
    80       REAL SSUM
    81 c
    82 c-----------------------------------------------------------------------
     80  REAL :: SSUM
     81  !
     82  !-----------------------------------------------------------------------
    8383
    84       DO k = 1,llm
    85          DO j = 1,ip1jmp1
    86             pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt
    87          ENDDO
    88       ENDDO
     84  DO k = 1,llm
     85     DO j = 1,ip1jmp1
     86        pteta(j,k)= pteta(j,k) + pdhfi(j,k) * pdt
     87     ENDDO
     88  ENDDO
    8989
    90       DO  k    = 1, llm
    91        DO  ij   = 1, iim
    92          xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
    93          xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
    94        ENDDO
    95        tpn      = SSUM(iim,xpn,1)/ apoln
    96        tps      = SSUM(iim,xps,1)/ apols
     90  DO  k    = 1, llm
     91   DO  ij   = 1, iim
     92     xpn(ij) = aire(   ij   ) * pteta(  ij    ,k)
     93     xps(ij) = aire(ij+ip1jm) * pteta(ij+ip1jm,k)
     94   ENDDO
     95   tpn      = SSUM(iim,xpn,1)/ apoln
     96   tps      = SSUM(iim,xps,1)/ apols
    9797
    98        DO ij   = 1, iip1
    99          pteta(   ij   ,k)  = tpn
    100          pteta(ij+ip1jm,k)  = tps
    101        ENDDO
    102       ENDDO
    103 c
     98   DO ij   = 1, iip1
     99     pteta(   ij   ,k)  = tpn
     100     pteta(ij+ip1jm,k)  = tps
     101   ENDDO
     102  ENDDO
     103  !
    104104
    105       DO k = 1,llm
    106          DO j = iip2,ip1jm
    107             pucov(j,k)= pucov(j,k) + pdufi(j,k) * pdt
    108          ENDDO
    109       ENDDO
     105  DO k = 1,llm
     106     DO j = iip2,ip1jm
     107        pucov(j,k)= pucov(j,k) + pdufi(j,k) * pdt
     108     ENDDO
     109  ENDDO
    110110
    111       DO k = 1,llm
    112          DO j = 1,ip1jm
    113             pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt
    114          ENDDO
    115       ENDDO
     111  DO k = 1,llm
     112     DO j = 1,ip1jm
     113        pvcov(j,k)= pvcov(j,k) + pdvfi(j,k) * pdt
     114     ENDDO
     115  ENDDO
    116116
    117 c
    118       DO j = 1,ip1jmp1
    119          pps(j) = pps(j) + pdpfi(j) * pdt
    120       ENDDO
    121  
    122       if (planet_type=="earth") then
    123       ! earth case, special treatment for first 2 tracers (water)
    124        DO iq = 1, 2
    125          DO k = 1,llm
    126             DO j = 1,ip1jmp1
    127                pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
    128                pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw )
    129             ENDDO
    130          ENDDO
    131        ENDDO
     117  !
     118  DO j = 1,ip1jmp1
     119     pps(j) = pps(j) + pdpfi(j) * pdt
     120  ENDDO
    132121
    133        DO iq = 3, nqtot
    134          DO k = 1,llm
    135             DO j = 1,ip1jmp1
    136                pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
    137                pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
    138             ENDDO
    139          ENDDO
    140        ENDDO
    141       else
    142       ! general case, treat all tracers equally)
    143        DO iq = 1, nqtot
    144          DO k = 1,llm
    145             DO j = 1,ip1jmp1
    146                pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
    147                pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
    148             ENDDO
    149          ENDDO
    150        ENDDO
    151       endif ! of if (planet_type=="earth")
     122  if (planet_type=="earth") then
     123  ! ! earth case, special treatment for first 2 tracers (water)
     124   DO iq = 1, 2
     125     DO k = 1,llm
     126        DO j = 1,ip1jmp1
     127           pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
     128           pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestw )
     129        ENDDO
     130     ENDDO
     131   ENDDO
     132
     133   DO iq = 3, nqtot
     134     DO k = 1,llm
     135        DO j = 1,ip1jmp1
     136           pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
     137           pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
     138        ENDDO
     139     ENDDO
     140   ENDDO
     141  else
     142  ! ! general case, treat all tracers equally)
     143   DO iq = 1, nqtot
     144     DO k = 1,llm
     145        DO j = 1,ip1jmp1
     146           pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
     147           pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
     148        ENDDO
     149     ENDDO
     150   ENDDO
     151  endif ! of if (planet_type=="earth")
    152152
    153153
     154  DO  ij   = 1, iim
     155    xpn(ij) = aire(   ij   ) * pps(  ij     )
     156    xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
     157  ENDDO
     158  tpn      = SSUM(iim,xpn,1)/apoln
     159  tps      = SSUM(iim,xps,1)/apols
     160
     161  DO ij   = 1, iip1
     162    pps (   ij     )  = tpn
     163    pps ( ij+ip1jm )  = tps
     164  ENDDO
     165
     166
     167  DO iq = 1, nqtot
     168    DO  k    = 1, llm
    154169      DO  ij   = 1, iim
    155         xpn(ij) = aire(   ij   ) * pps(  ij     )
    156         xps(ij) = aire(ij+ip1jm) * pps(ij+ip1jm )
     170        xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
     171        xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
    157172      ENDDO
    158173      tpn      = SSUM(iim,xpn,1)/apoln
    … …  
    160175
    161176      DO ij   = 1, iip1
    162         pps (   ij     )  = tpn
    163         pps ( ij+ip1jm )  = tps
     177        pq (   ij   ,k,iq)  = tpn
     178        pq (ij+ip1jm,k,iq)  = tps
    164179      ENDDO
     180    ENDDO
     181  ENDDO
    165182
    166 
    167       DO iq = 1, nqtot
    168         DO  k    = 1, llm
    169           DO  ij   = 1, iim
    170             xpn(ij) = aire(   ij   ) * pq(  ij    ,k,iq)
    171             xps(ij) = aire(ij+ip1jm) * pq(ij+ip1jm,k,iq)
    172           ENDDO
    173           tpn      = SSUM(iim,xpn,1)/apoln
    174           tps      = SSUM(iim,xps,1)/apols
    175 
    176           DO ij   = 1, iip1
    177             pq (   ij   ,k,iq)  = tpn
    178             pq (ij+ip1jm,k,iq)  = tps
    179           ENDDO
    180         ENDDO
    181       ENDDO
    182 
    183       RETURN
    184       END
     183  RETURN
     184END SUBROUTINE addfi
Note: See TracChangeset for help on using the changeset viewer.