Changeset 4207 for dynamico_lmdz


Ignore:
Timestamp:
Dec 30, 2019, 1:57:35 PM (5 years ago)
Author:
dubos
Message:

simple_physics : converted soil.F to F90

Location:
dynamico_lmdz/simple_physics/phyparam
Files:
1 edited
1 moved

Legend:

Unmodified
Added
Removed
  • dynamico_lmdz/simple_physics/phyparam/param/soil.F90

    r4196 r4207  
    1       SUBROUTINE soil(ngrid,nsoil,firstcall,ptherm_i,
    2      s          ptimestep,ptsrf,ptsoil,
    3      s          pcapcal,pfluxgrd)
    4       IMPLICIT NONE
    5 
    6 c=======================================================================
    7 c
    8 c   Auteur:  Frederic Hourdin     30/01/92
    9 c   -------
    10 c
    11 c   objet:  computation of : the soil temperature evolution
    12 c   ------                   the surfacic heat capacity "Capcal"
    13 c                            the surface conduction flux pcapcal
    14 c
    15 c
    16 c   Method: implicit time integration
    17 c   -------
    18 c   Consecutive ground temperatures are related by:
    19 c           T(k+1) = C(k) + D(k)*T(k)  (1)
    20 c   the coefficients C and D are computed at the t-dt time-step.
    21 c   Routine structure:
    22 c   1)new temperatures are computed  using (1)
    23 c   2)C and D coefficients are computed from the new temperature
    24 c     profile for the t+dt time-step
    25 c   3)the coefficients A and B are computed where the diffusive
    26 c     fluxes at the t+dt time-step is given by
    27 c            Fdiff = A + B Ts(t+dt)
    28 c     or     Fdiff = F0 + Capcal (Ts(t+dt)-Ts(t))/dt
    29 c            with F0 = A + B (Ts(t))
    30 c                 Capcal = B*dt
    31 c           
    32 c   Interface:
    33 c   ----------
    34 c
    35 c   Arguments:
    36 c   ----------
    37 c   ngird               number of grid-points
    38 c   ptimestep              physical timestep (s)
    39 c   pto(ngrid,nsoil)     temperature at time-step t (K)
    40 c   ptn(ngrid,nsoil)     temperature at time step t+dt (K)
    41 c   pcapcal(ngrid)      specific heat (W*m-2*s*K-1)
    42 c   pfluxgrd(ngrid)      surface diffusive flux from ground (Wm-2)
    43 c   
    44 c=======================================================================
    45 c   declarations:
    46 c   -------------
    47 
    48 
    49 c-----------------------------------------------------------------------
    50 c  arguments
    51 c  ---------
    52 
    53       INTEGER ngrid,nsoil
    54       REAL ptimestep
    55       REAL ptsrf(ngrid),ptsoil(ngrid,nsoil),ptherm_i(ngrid)
    56       REAL pcapcal(ngrid),pfluxgrd(ngrid)
    57       LOGICAL firstcall
    58 
    59 
    60 c-----------------------------------------------------------------------
    61 c  local arrays
    62 c  ------------
    63 
    64       INTEGER ig,jk
    65       REAL za(ngrid),zb(ngrid)
    66       REAL zdz2(nsoil),z1(ngrid)
    67       REAL min_period,dalph_soil
    68 
    69 c   local saved variables:
    70 c   ----------------------
    71       REAL,SAVE :: lambda
    72       REAL,ALLOCATABLE,SAVE :: dz1(:),dz2(:),zc(:,:),zd(:,:)
    73 !$OMP THREADPRIVATE(dz1,dz2,zc,zd,lambda)
    74 
    75 c-----------------------------------------------------------------------
    76 c   Depthts:
    77 c   --------
    78 
    79       REAL fz,rk,fz1,rk1,rk2
    80       fz(rk)=fz1*(dalph_soil**rk-1.)/(dalph_soil-1.)
    81 
    82       print*,'firstcall soil ',firstcall
    83       IF (firstcall) THEN
    84 
    85 c-----------------------------------------------------------------------
    86 c   ground levels
    87 c   grnd=z/l where l is the skin depth of the diurnal cycle:
    88 c   --------------------------------------------------------
    89 
    90          print*,'nsoil,ngrid,firstcall=',nsoil,ngrid,firstcall
    91          ALLOCATE(dz1(nsoil),dz2(nsoil))
    92          ALLOCATE(zc(ngrid,nsoil),zd(ngrid,nsoil))
    93 
    94          min_period=20000.
    95          dalph_soil=2.
    96 
    97          OPEN(99,file='soil.def',status='old',form='formatted',err=9999)
    98          READ(99,*) min_period
    99          READ(99,*) dalph_soil
    100          PRINT*,'Discretization for the soil model'
    101          PRINT*,'First level e-folding depth',min_period,
    102      s   '   dalph',dalph_soil
    103          CLOSE(99)
    104 9999     CONTINUE
    105 
    106 c   la premiere couche represente un dixieme de cycle diurne
    107          fz1=sqrt(min_period/3.14)
    108 
    109          DO jk=1,nsoil
    110             rk1=jk
    111             rk2=jk-1
    112             dz2(jk)=fz(rk1)-fz(rk2)
    113          ENDDO
    114          DO jk=1,nsoil-1
    115             rk1=jk+.5
    116             rk2=jk-.5
    117             dz1(jk)=1./(fz(rk1)-fz(rk2))
    118          ENDDO
    119          lambda=fz(.5)*dz1(1)
    120          PRINT*,'full layers, intermediate layers (secoonds)'
    121          DO jk=1,nsoil
    122             rk=jk
    123             rk1=jk+.5
    124             rk2=jk-.5
    125             PRINT*,fz(rk1)*fz(rk2)*3.14,
    126      s      fz(rk)*fz(rk)*3.14
    127          ENDDO
    128 
    129 c   Initialisations:
    130 c   ----------------
    131 
    132       ELSE
    133 c-----------------------------------------------------------------------
    134 c   Computation of the soil temperatures using the Cgrd and Dgrd
    135 c  coefficient computed at the previous time-step:
    136 c  -----------------------------------------------
    137 
    138 c    surface temperature
    139          DO ig=1,ngrid
    140             ptsoil(ig,1)=(lambda*zc(ig,1)+ptsrf(ig))/
    141      s      (lambda*(1.-zd(ig,1))+1.)
    142          ENDDO
    143 
    144 c   other temperatures
    145          DO jk=1,nsoil-1
    146             DO ig=1,ngrid
    147                ptsoil(ig,jk+1)=zc(ig,jk)+zd(ig,jk)*ptsoil(ig,jk)
    148             ENDDO
    149          ENDDO
    150 
    151       ENDIF
    152 c-----------------------------------------------------------------------
    153 c   Computation of the Cgrd and Dgrd coefficient for the next step:
    154 c   ---------------------------------------------------------------
    155 
    156       DO jk=1,nsoil
    157          zdz2(jk)=dz2(jk)/ptimestep
    158       ENDDO
    159 
    160       DO ig=1,ngrid
    161          z1(ig)=zdz2(nsoil)+dz1(nsoil-1)
    162          zc(ig,nsoil-1)=zdz2(nsoil)*ptsoil(ig,nsoil)/z1(ig)
    163          zd(ig,nsoil-1)=dz1(nsoil-1)/z1(ig)
    164       ENDDO
    165 
    166       DO jk=nsoil-1,2,-1
    167          DO ig=1,ngrid
    168             z1(ig)=1./(zdz2(jk)+dz1(jk-1)+dz1(jk)*(1.-zd(ig,jk)))
    169             zc(ig,jk-1)=
    170      s      (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*zc(ig,jk))*z1(ig)
    171             zd(ig,jk-1)=dz1(jk-1)*z1(ig)
    172          ENDDO
    173       ENDDO
    174 
    175 c-----------------------------------------------------------------------
    176 c   computation of the surface diffusive flux from ground and
    177 c   calorific capacity of the ground:
    178 c   ---------------------------------
    179 
    180       DO ig=1,ngrid
    181          pfluxgrd(ig)=ptherm_i(ig)*dz1(1)*
    182      s   (zc(ig,1)+(zd(ig,1)-1.)*ptsoil(ig,1))
    183          pcapcal(ig)=ptherm_i(ig)*
    184      s   (dz2(1)+ptimestep*(1.-zd(ig,1))*dz1(1))
    185          z1(ig)=lambda*(1.-zd(ig,1))+1.
    186          pcapcal(ig)=pcapcal(ig)/z1(ig)
    187          pfluxgrd(ig)=pfluxgrd(ig)
    188      s   +pcapcal(ig)*(ptsoil(ig,1)*z1(ig)-lambda*zc(ig,1)-ptsrf(ig))
    189      s   /ptimestep
    190       ENDDO
    191 
    192       RETURN
    193       END
     1      SUBROUTINE soil(ngrid,nsoil,firstcall,ptherm_i,                   &
     2     &          ptimestep,ptsrf,ptsoil,                                 &
     3     &          pcapcal,pfluxgrd)                                       
     4      IMPLICIT NONE 
     5                                                                       
     6!=======================================================================
     7!                                                                       
     8!   Auteur:  Frederic Hourdin     30/01/92                             
     9!   -------                                                             
     10!                                                                       
     11!   objet:  computation of : the soil temperature evolution             
     12!   ------                   the surfacic heat capacity "Capcal"       
     13!                            the surface conduction flux pcapcal       
     14!                                                                       
     15!                                                                       
     16!   Method: implicit time integration                                   
     17!   -------                                                             
     18!   Consecutive ground temperatures are related by:                     
     19!           T(k+1) = C(k) + D(k)*T(k)  (1)                             
     20!   the coefficients C and D are computed at the t-dt time-step.       
     21!   Routine structure:                                                 
     22!   1)new temperatures are computed  using (1)                         
     23!   2)C and D coefficients are computed from the new temperature       
     24!     profile for the t+dt time-step                                   
     25!   3)the coefficients A and B are computed where the diffusive         
     26!     fluxes at the t+dt time-step is given by                         
     27!            Fdiff = A + B Ts(t+dt)                                     
     28!     or     Fdiff = F0 + Capcal (Ts(t+dt)-Ts(t))/dt                   
     29!            with F0 = A + B (Ts(t))                                   
     30!                 Capcal = B*dt                                         
     31!                                                                       
     32!   Interface:                                                         
     33!   ----------                                                         
     34!                                                                       
     35!   Arguments:                                                         
     36!   ----------                                                         
     37!   ngird               number of grid-points                           
     38!   ptimestep              physical timestep (s)                       
     39!   pto(ngrid,nsoil)     temperature at time-step t (K)                 
     40!   ptn(ngrid,nsoil)     temperature at time step t+dt (K)             
     41!   pcapcal(ngrid)      specific heat (W*m-2*s*K-1)                     
     42!   pfluxgrd(ngrid)      surface diffusive flux from ground (Wm-2)     
     43!                                                                       
     44!=======================================================================
     45!   declarations:                                                       
     46!   -------------                                                       
     47                                                                       
     48                                                                       
     49!-----------------------------------------------------------------------
     50!  arguments                                                           
     51!  ---------                                                           
     52                                                                       
     53      INTEGER ngrid,nsoil 
     54      REAL ptimestep 
     55      REAL ptsrf(ngrid),ptsoil(ngrid,nsoil),ptherm_i(ngrid) 
     56      REAL pcapcal(ngrid),pfluxgrd(ngrid) 
     57      LOGICAL firstcall 
     58                                                                       
     59                                                                       
     60!-----------------------------------------------------------------------
     61!  local arrays                                                         
     62!  ------------                                                         
     63                                                                       
     64      INTEGER ig,jk 
     65      REAL za(ngrid),zb(ngrid) 
     66      REAL zdz2(nsoil),z1(ngrid) 
     67      REAL min_period,dalph_soil 
     68                                                                       
     69!   local saved variables:                                             
     70!   ----------------------                                             
     71      REAL,SAVE :: lambda 
     72      REAL,ALLOCATABLE,SAVE :: dz1(:),dz2(:),zc(:,:),zd(:,:) 
     73!$OMP THREADPRIVATE(dz1,dz2,zc,zd,lambda)                               
     74                                                                       
     75!-----------------------------------------------------------------------
     76!   Depthts:                                                           
     77!   --------                                                           
     78                                                                       
     79      REAL fz,rk,fz1,rk1,rk2 
     80      fz(rk)=fz1*(dalph_soil**rk-1.)/(dalph_soil-1.) 
     81                                                                       
     82      print*,'firstcall soil ',firstcall 
     83      IF (firstcall) THEN 
     84                                                                       
     85!-----------------------------------------------------------------------
     86!   ground levels                                                     
     87!   grnd=z/l where l is the skin depth of the diurnal cycle:           
     88!   --------------------------------------------------------           
     89                                                                       
     90         print*,'nsoil,ngrid,firstcall=',nsoil,ngrid,firstcall 
     91         ALLOCATE(dz1(nsoil),dz2(nsoil)) 
     92         ALLOCATE(zc(ngrid,nsoil),zd(ngrid,nsoil)) 
     93                                                                       
     94         min_period=20000. 
     95         dalph_soil=2. 
     96                                                                       
     97         OPEN(99,file='soil.def',status='old',form='formatted',err=9999) 
     98         READ(99,*) min_period 
     99         READ(99,*) dalph_soil 
     100         PRINT*,'Discretization for the soil model' 
     101         PRINT*,'First level e-folding depth',min_period,               &
     102     &   '   dalph',dalph_soil                                         
     103         CLOSE(99) 
     104 9999    CONTINUE
     105                                                                       
     106!   la premiere couche represente un dixieme de cycle diurne           
     107         fz1=sqrt(min_period/3.14) 
     108                                                                       
     109         DO jk=1,nsoil 
     110            rk1=jk 
     111            rk2=jk-1 
     112            dz2(jk)=fz(rk1)-fz(rk2) 
     113         ENDDO 
     114         DO jk=1,nsoil-1 
     115            rk1=jk+.5 
     116            rk2=jk-.5 
     117            dz1(jk)=1./(fz(rk1)-fz(rk2)) 
     118         ENDDO 
     119         lambda=fz(.5)*dz1(1) 
     120         PRINT*,'full layers, intermediate layers (secoonds)' 
     121         DO jk=1,nsoil 
     122            rk=jk 
     123            rk1=jk+.5 
     124            rk2=jk-.5 
     125            PRINT*,fz(rk1)*fz(rk2)*3.14,                                &
     126     &      fz(rk)*fz(rk)*3.14                                         
     127         ENDDO 
     128                                                                       
     129!   Initialisations:                                                   
     130!   ----------------                                                   
     131                                                                       
     132      ELSE 
     133!-----------------------------------------------------------------------
     134!   Computation of the soil temperatures using the Cgrd and Dgrd       
     135!  coefficient computed at the previous time-step:                     
     136!  -----------------------------------------------                     
     137                                                                       
     138!    surface temperature                                               
     139         DO ig=1,ngrid 
     140            ptsoil(ig,1)=(lambda*zc(ig,1)+ptsrf(ig))/                   &
     141     &      (lambda*(1.-zd(ig,1))+1.)                                   
     142         ENDDO 
     143                                                                       
     144!   other temperatures                                                 
     145         DO jk=1,nsoil-1 
     146            DO ig=1,ngrid 
     147               ptsoil(ig,jk+1)=zc(ig,jk)+zd(ig,jk)*ptsoil(ig,jk) 
     148            ENDDO 
     149         ENDDO 
     150                                                                       
     151      ENDIF 
     152!-----------------------------------------------------------------------
     153!   Computation of the Cgrd and Dgrd coefficient for the next step:     
     154!   ---------------------------------------------------------------     
     155                                                                       
     156      DO jk=1,nsoil 
     157         zdz2(jk)=dz2(jk)/ptimestep 
     158      ENDDO 
     159                                                                       
     160      DO ig=1,ngrid 
     161         z1(ig)=zdz2(nsoil)+dz1(nsoil-1) 
     162         zc(ig,nsoil-1)=zdz2(nsoil)*ptsoil(ig,nsoil)/z1(ig) 
     163         zd(ig,nsoil-1)=dz1(nsoil-1)/z1(ig) 
     164      ENDDO 
     165                                                                       
     166      DO jk=nsoil-1,2,-1 
     167         DO ig=1,ngrid 
     168            z1(ig)=1./(zdz2(jk)+dz1(jk-1)+dz1(jk)*(1.-zd(ig,jk))) 
     169            zc(ig,jk-1)=                                                &
     170     &      (ptsoil(ig,jk)*zdz2(jk)+dz1(jk)*zc(ig,jk))*z1(ig)           
     171            zd(ig,jk-1)=dz1(jk-1)*z1(ig) 
     172         ENDDO 
     173      ENDDO 
     174                                                                       
     175!-----------------------------------------------------------------------
     176!   computation of the surface diffusive flux from ground and           
     177!   calorific capacity of the ground:                                   
     178!   ---------------------------------                                   
     179                                                                       
     180      DO ig=1,ngrid 
     181         pfluxgrd(ig)=ptherm_i(ig)*dz1(1)*                              &
     182     &   (zc(ig,1)+(zd(ig,1)-1.)*ptsoil(ig,1))                         
     183         pcapcal(ig)=ptherm_i(ig)*                                      &
     184     &   (dz2(1)+ptimestep*(1.-zd(ig,1))*dz1(1))                       
     185         z1(ig)=lambda*(1.-zd(ig,1))+1. 
     186         pcapcal(ig)=pcapcal(ig)/z1(ig) 
     187         pfluxgrd(ig)=pfluxgrd(ig)                                      &
     188     &   +pcapcal(ig)*(ptsoil(ig,1)*z1(ig)-lambda*zc(ig,1)-ptsrf(ig))   &
     189     &   /ptimestep                                                     
     190      ENDDO 
     191                                                                       
     192      RETURN 
     193      END                                           
  • dynamico_lmdz/simple_physics/phyparam/physics/convection.F90

    r4206 r4207  
    2727    REAL, INTENT(INOUT) :: zu2(ngrid,nlay), zv2(ngrid,nlay), zh2(ngrid,nlay)
    2828
    29     INTEGER :: l,l1,l2,jj
     29    INTEGER :: l,l1,l2
    3030    LOGICAL :: extend
    3131    REAL :: zhm,zsm,zum,zvm,zalpha
    32 #include "dimensions.h"
    3332
    3433    l2=1
Note: See TracChangeset for help on using the changeset viewer.