Ignore:
Timestamp:
Jul 24, 2024, 1:17:08 PM (4 months ago)
Author:
abarral
Message:

Rename modules in misc from *_mod > lmdz_*
Put cbrt.f90, ch*.f90, pch*.f90 in new lmdz_libmath_pch.f90

Location:
LMDZ6/branches/Amaury_dev/libf/dyn3d
Files:
18 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/addfi.F90

    r5105 r5113  
    120120
    121121  if (planet_type=="earth") then
    122     ! ! earth case, special treatment for first 2 tracers (water)
     122    ! earth case, special treatment for first 2 tracers (water)
    123123    DO iq = 1, 2
    124124      DO k = 1, llm
    … …  
    139139    ENDDO
    140140  else
    141     ! ! general case, treat all tracers equally)
     141    ! general case, treat all tracers equally)
    142142    DO iq = 1, nqtot
    143143      DO k = 1, llm

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/caladvtrac.F90

    r5106 r5113  
    8484      ENDDO
    8585
    86       ! !write(*,*) 'caladvtrac 87'
     86      !write(*,*) 'caladvtrac 87'
    8787      CALL qminimum(q, nqtot, finmasse)
    88       ! !write(*,*) 'caladvtrac 89'
     88      !write(*,*) 'caladvtrac 89'
    8989
    9090      CALL SCOPY   (ip1jmp1 * llm, masse, 1, finmasse, 1)

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/caldyn.F90

    r5103 r5113  
    6969  !--------------------------------
    7070
    71   ! ! compute contravariant winds ucont() and vcont
     71  ! compute contravariant winds ucont() and vcont
    7272  CALL covcont  (llm, ucov, vcov, ucont, vcont)
    73   ! ! compute pressure p()
     73  ! compute pressure p()
    7474  CALL pression (ip1jmp1, ap, bp, ps, p)
    75   ! ! compute psexbarxy() XY-area weighted-averaged surface pressure (what for?)
     75  ! compute psexbarxy() XY-area weighted-averaged surface pressure (what for?)
    7676  CALL psextbar (ps, psexbarxy)
    77   ! ! compute mass in each atmospheric mesh: masse()
     77  ! compute mass in each atmospheric mesh: masse()
    7878  CALL massdair (p, masse)
    79   ! ! compute X and Y-averages of mass, massebx() and masseby()
     79  ! compute X and Y-averages of mass, massebx() and masseby()
    8080  CALL massbar  (masse, massebx, masseby)
    81   ! ! compute XY-average of mass, massebxy()
     81  ! compute XY-average of mass, massebxy()
    8282  CALL massbarxy(masse, massebxy)
    83   ! ! compute mass fluxes pbaru() and pbarv()
     83  ! compute mass fluxes pbaru() and pbarv()
    8484  CALL flumass  (massebx, masseby, vcont, ucont, pbaru, pbarv)
    85   ! ! compute dteta() , horizontal converging flux of theta
     85  ! compute dteta() , horizontal converging flux of theta
    8686  CALL dteta1   (teta, pbaru, pbarv, dteta)
    87   ! ! compute convm(), horizontal converging flux of mass
     87  ! compute convm(), horizontal converging flux of mass
    8888  CALL convmas  (pbaru, pbarv, convm)
    8989
    90   ! ! compute pressure variation due to mass convergence
     90  ! compute pressure variation due to mass convergence
    9191  DO ij = 1, ip1jmp1
    9292    dp(ij) = convm(ij, 1) / airesurg(ij)
    9393  ENDDO
    9494
    95   ! ! compute vertical velocity w()
     95  ! compute vertical velocity w()
    9696  CALL vitvert (convm, w)
    97   ! ! compute potential vorticity vorpot()
     97  ! compute potential vorticity vorpot()
    9898  CALL tourpot (vcov, ucov, massebxy, vorpot)
    99   ! ! compute rotation induced du() and dv()
     99  ! compute rotation induced du() and dv()
    100100  CALL dudv1   (vorpot, pbaru, pbarv, du, dv)
    101   ! ! compute kinetic energy ecin()
     101  ! compute kinetic energy ecin()
    102102  CALL enercin (vcov, ucov, vcont, ucont, ecin)
    103   ! ! compute Bernouilli function bern()
     103  ! compute Bernouilli function bern()
    104104  CALL bernoui (ip1jmp1, llm, phi, ecin, bern)
    105   ! ! compute and add du() and dv() contributions from Bernouilli and pressure
     105  ! compute and add du() and dv() contributions from Bernouilli and pressure
    106106  CALL dudv2   (teta, pkf, bern, du, dv)
    107107
    … …  
    112112  ENDDO
    113113
    114   ! ! compute vertical advection contributions to du(), dv() and dteta()
     114  ! compute vertical advection contributions to du(), dv() and dteta()
    115115  CALL advect(ang, vcov, teta, w, massebx, masseby, du, dv, dteta)
    116116

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/conf_gcm.f90

    r5103 r5113  
    66  use IOIPSL
    77  USE infotrac, ONLY: type_trac
    8   use assert_m, only: assert
     8  use lmdz_assert, only: assert
    99  USE comconst_mod, ONLY: dissip_deltaz, dissip_factz, dissip_zref, &
    1010          iflag_top_bound, mode_top_bound, tau_top_bound, &

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/dissip.F90

    r5105 r5113  
    3939  REAL, INTENT(IN) :: teta(ip1jmp1, llm) ! potential temperature
    4040  REAL, INTENT(IN) :: p(ip1jmp1, llmp1) ! pressure
    41   ! ! tendencies (.../s) on covariant winds and potential temperature
     41  ! tendencies (.../s) on covariant winds and potential temperature
    4242  REAL, INTENT(OUT) :: dv(ip1jm, llm)
    4343  REAL, INTENT(OUT) :: du(ip1jmp1, llm)

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/dynetat0.F90

    r5101 r5113  
    1212  USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey
    1313  USE control_mod, ONLY: planet_type
    14   USE assert_eq_m, ONLY: assert_eq
     14  USE lmdz_assert_eq, ONLY: assert_eq
    1515  USE comvert_mod, ONLY: pa,preff
    1616  USE comconst_mod, ONLY: cpp, daysec, dtvr, g, im, jm, kappa, lllm, omeg, rad

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/friction.F90

    r5105 r5113  
    4545
    4646  IF (firstcall) THEN
    47     ! ! set friction type
     47    ! set friction type
    4848    CALL getin("friction_type", friction_type)
    4949    if ((friction_type<0).or.(friction_type>1)) then

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/getparam.F90

    r5103 r5113  
    88     MODULE PROCEDURE getparamr,getparami,getparaml
    99   END INTERFACE
    10    private getparamr,getparami,getparaml
     10   PRIVATE getparamr,getparami,getparaml
    1111
    1212   INTEGER, PARAMETER :: out_eff=99

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/groupe.F90

    r5105 r5113  
    55  use comconst_mod, only: ngroup
    66
    7   implicit none
     7  IMPLICIT NONE
    88
    99  !   sous-programme servant a fitlrer les champs de flux de masse aux

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/guide_mod.F90

    r5105 r5113  
    924924    use serre_mod, only: clon, clat, grossismx, grossismy
    925925   
    926     implicit none
     926    IMPLICIT NONE
    927927
    928928    include "dimensions.h"

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/iniinterp_horiz.F90

    r5106 r5113  
    66        ktotal, iik, jjk, jk, ik, intersec, airen)
    77
    8   implicit none
     8  IMPLICIT NONE
    99
    1010

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/integrd.F90

    r5105 r5113  
    4646  real, intent(inout) :: masse(ip1jmp1, llm) ! atmospheric mass
    4747  real, intent(in) :: phis(ip1jmp1) ! ground geopotential !!! unused
    48   ! ! values at previous time step
     48  ! values at previous time step
    4949  real, intent(inout) :: vcovm1(ip1jm, llm)
    5050  real, intent(inout) :: ucovm1(ip1jmp1, llm)
    … …  
    5252  real, intent(inout) :: psm1(ip1jmp1)
    5353  real, intent(inout) :: massem1(ip1jmp1, llm)
    54   ! ! the tendencies to add
     54  ! the tendencies to add
    5555  real, intent(in) :: dv(ip1jm, llm)
    5656  real, intent(in) :: du(ip1jmp1, llm)
    … …  
    100100      write(lunout, *) "integrd: negative surface pressure ", ps(ij)
    101101      write(lunout, *) " at node ij =", ij
    102       ! ! since ij=j+(i-1)*jjp1 , we have
     102      ! since ij=j+(i-1)*jjp1 , we have
    103103      j = modulo(ij, jjp1)
    104104      i = 1 + (ij - j) / jjp1

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/leapfrog.F90

    r5105 r5113  
    294294
    295295  IF(purmats) THEN
    296     ! ! Purely Matsuno time stepping
     296    ! Purely Matsuno time stepping
    297297    IF(MOD(itau, iconser) ==0.AND.  forward) conser = .TRUE.
    298298    IF(MOD(itau, dissip_period)==0.AND..NOT.forward) &
    … …  
    301301            .and. physic) apphys = .TRUE.
    302302  ELSE
    303     ! ! Leapfrog/Matsuno time stepping
     303    ! Leapfrog/Matsuno time stepping
    304304    IF(MOD(itau, iconser) == 0) conser = .TRUE.
    305305    IF(MOD(itau + 1, dissip_period)==0 .AND. .NOT. forward) &
    … …  
    320320  !   --------------------------------
    321321
    322   ! ! compute geopotential phi()
     322  ! compute geopotential phi()
    323323  CALL geopot  (ip1jmp1, teta, pk, pks, phis, phi)
    324324
    … …  
    341341            p, masse, dq, teta, &
    342342            flxw, pk)
    343     ! !write(*,*) 'caladvtrac 346'
     343    !write(*,*) 'caladvtrac 346'
    344344
    345345    IF (offline) THEN
    … …  
    409409
    410410    IF (planet_type =="generic") THEN
    411       ! ! AS: we make jD_cur to be pday
     411      ! AS: we make jD_cur to be pday
    412412      jD_cur = int(day_ini + itau / day_step)
    413413    ENDIF
    … …  
    450450            ucov, vcov, teta, q, ps, &
    451451            dufi, dvfi, dtetafi, dqfi, dpfi)
    452     ! ! since addfi updates ps(), also update p(), masse() and pk()
     452    ! since addfi updates ps(), also update p(), masse() and pk()
    453453    CALL pression (ip1jmp1, ap, bp, ps, p)
    454454    CALL massdair(p, masse)
    … …  
    486486
    487487    if (planet_type=="giant") then
    488       ! ! add an intrinsic heat flux at the base of the atmosphere
     488      ! add an intrinsic heat flux at the base of the atmosphere
    489489      teta(:, 1) = teta(:, 1) + dtvr * aire(:) * ihf / cpp / masse(:, 1)
    490490    endif
    … …  
    492492    CALL friction(ucov, vcov, dtvr)
    493493
    494     ! ! Sponge layer (if any)
     494    ! Sponge layer (if any)
    495495    IF (ok_strato) THEN
    496496      ! dufi(:,:)=0.
    … …  
    646646      ENDIF
    647647
    648       ! ! Ehouarn: re-compute geopotential for outputs
     648      ! Ehouarn: re-compute geopotential for outputs
    649649      CALL geopot(ip1jmp1, teta, pk, pks, phis, phi)
    650650

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/qminimum.F90

    r5105 r5113  
    4141  SAVE imprim
    4242  DATA imprim /0/
    43   ! !INTEGER ijb,ije
    44   ! !INTEGER Index_pump(ij_end-ij_begin+1)
    45   ! !INTEGER nb_pump
     43  !INTEGER ijb,ije
     44  !INTEGER Index_pump(ij_end-ij_begin+1)
     45  !INTEGER nb_pump
    4646  INTEGER :: ixt
    4747
    … …  
    113113  ENDIF
    114114
    115   ! !write(*,*) 'qminimum 128'
     115  !write(*,*) 'qminimum 128'
    116116  if (niso > 0) then
    117     ! ! CRisi: traiter de même les traceurs d'eau
    118     ! ! Mais il faut les prendre à l'envers pour essayer de conserver la
    119     ! ! masse.
    120     ! ! 1) pompage dans le sol
    121     ! ! On suppose que ce pompage se fait sans isotopes -> on ne modifie
    122     ! ! rien ici et on croise les doigts pour que ça ne soit pas trop
    123     ! ! génant
     117    ! CRisi: traiter de même les traceurs d'eau
     118    ! Mais il faut les prendre à l'envers pour essayer de conserver la
     119    ! masse.
     120    ! 1) pompage dans le sol
     121    ! On suppose que ce pompage se fait sans isotopes -> on ne modifie
     122    ! rien ici et on croise les doigts pour que ça ne soit pas trop
     123    ! génant
    124124    DO i = 1, ip1jmp1
    125125      if (zx_pump(i)>0.0) then
    … …  
    128128    enddo !DO i = 1,ip1jmp1
    129129
    130     ! ! 2) transfert de vap vers les couches plus hautes
    131     ! !write(*,*) 'qminimum 139'
     130    ! 2) transfert de vap vers les couches plus hautes
     131    !write(*,*) 'qminimum 139'
    132132    do k = 2, llm
    133133      DO i = 1, ip1jmp1
    134134        if (zx_defau_diag(i, k, 1)>0.0) then
    135           ! ! on ajoute la vapeur en k
     135          ! on ajoute la vapeur en k
    136136          do ixt = 1, ntiso
    137137            q(i, k, iqIsoPha(ixt, iq_vap)) = q(i, k, iqIsoPha(ixt, iq_vap)) &
    … …  
    139139                            * q(i, k - 1, iqIsoPha(ixt, iq_vap)) / q_follow(i, k - 1, 1)
    140140
    141             ! ! et on la retranche en k-1
     141            ! et on la retranche en k-1
    142142            q(i, k - 1, iqIsoPha(ixt, iq_vap)) = &
    143143                    q(i, k - 1, iqIsoPha(ixt, iq_vap)) &
    … …  
    160160
    161161
    162     ! ! 3) transfert d'eau de la vapeur au liquide
    163     ! !write(*,*) 'qminimum 164'
     162    ! 3) transfert d'eau de la vapeur au liquide
     163    !write(*,*) 'qminimum 164'
    164164    do k = 1, llm
    165165      DO i = 1, ip1jmp1

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/top_bound.F90

    r5103 r5113  
    114114  CALL massbar(masse, massebx, masseby)
    115115
    116   ! ! compute zonal average of vcov and u
     116  ! compute zonal average of vcov and u
    117117  if (mode_top_bound>=2) then
    118118    do l = 1, llm
    … …  
    146146  endif ! of if (mode_top_bound.ge.2)
    147147
    148   ! ! compute zonal average of potential temperature, if necessary
     148  ! compute zonal average of potential temperature, if necessary
    149149  if (mode_top_bound>=3) then
    150150    do l = 1, llm
    … …  
    162162
    163163  if (mode_top_bound>=1) then
    164     ! ! Apply sponge quenching on vcov:
     164    ! Apply sponge quenching on vcov:
    165165    do l = 1, llm
    166166      do i = 1, iip1
    … …  
    172172    enddo
    173173
    174     ! ! Apply sponge quenching on ucov:
     174    ! Apply sponge quenching on ucov:
    175175    do l = 1, llm
    176176      do i = 1, iip1
    … …  
    184184
    185185  if (mode_top_bound>=3) then
    186     ! ! Apply sponge quenching on teta:
     186    ! Apply sponge quenching on teta:
    187187    do l = 1, llm
    188188      do i = 1, iip1

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/vlsplt.F90

    r5105 r5113  
    8989     ENDDO
    9090  ENDDO
    91   ! ! CRisi: aussi pour les fils
     91  ! CRisi: aussi pour les fils
    9292  do ifils=1,tracers(iq)%nqDescen
    9393    iq2=tracers(iq)%iqDescen(ifils)
    … …  
    143143  REAL :: u_mq(ip1jmp1,llm)
    144144
    145   ! ! CRisi
     145  ! CRisi
    146146  REAL :: masseq(ip1jmp1,llm,nqtot),Ratio(ip1jmp1,llm,nqtot)
    147147  INTEGER :: ifils,iq2 ! CRisi
    … …  
    361361  ! CRisi: appel récursif de l'advection sur les fils.
    362362  ! Il faut faire ça avant d'avoir mis à jour q et masse
    363   ! !write(*,*) 'vlsplt 326: iq,nqDesc(iq)=',iq,tracers(iq)%nqDescen
     363  !write(*,*) 'vlsplt 326: iq,nqDesc(iq)=',iq,tracers(iq)%nqDescen
    364364
    365365  do ifils=1,tracers(iq)%nqDescen
    … …  
    367367    DO l=1,llm
    368368      DO ij=iip2,ip1jm
    369         ! ! On a besoin de q et masse seulement entre iip2 et ip1jm
    370         ! !masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
     369        ! On a besoin de q et masse seulement entre iip2 et ip1jm
     370        !masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    371371  !           !Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    372         ! !Mvals: veiller a ce qu'on n'ait pas de denominateur nul
     372        !Mvals: veiller a ce qu'on n'ait pas de denominateur nul
    373373        masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass)
    374374        if (q(ij,l,iq)>min_qParent) then
    … …  
    391391  DO l=1,llm
    392392     DO ij=iip2+1,ip1jm
    393         ! !MVals: veiller a ce qu'on ait pas de denominateur nul
     393        !MVals: veiller a ce qu'on ait pas de denominateur nul
    394394        new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),min_qMass)
    395395        q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+ &
    … …  
    404404  ENDDO
    405405
    406   ! ! retablir les fils en rapport de melange par rapport a l'air:
    407   ! ! On calcule q entre iip2+1,ip1jm -> on fait pareil pour ratio
    408   ! ! puis on boucle en longitude
     406  ! retablir les fils en rapport de melange par rapport a l'air:
     407  ! On calcule q entre iip2+1,ip1jm -> on fait pareil pour ratio
     408  ! puis on boucle en longitude
    409409  do ifils=1,tracers(iq)%nqDescen
    410410    iq2=tracers(iq)%iqDescen(ifils)

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/vlspltqs.F90

    r5106 r5113  
    159159    ENDDO
    160160  ENDDO
    161   ! ! CRisi: aussi pour les fils
     161  ! CRisi: aussi pour les fils
    162162  do ifils = 1, tracers(iq)%nqDescen
    163163    iq2 = tracers(iq)%iqDescen(ifils)
    … …  
    171171    ENDDO
    172172  enddo
    173   ! !write(*,*) 'vlspltqs 183: fin de la routine'
     173  !write(*,*) 'vlspltqs 183: fin de la routine'
    174174
    175175
    … …  
    212212  REAL :: u_mq(ip1jmp1, llm)
    213213
    214   ! ! CRisi
     214  ! CRisi
    215215  REAL :: masseq(ip1jmp1, llm, nqtot), Ratio(ip1jmp1, llm, nqtot)
    216216  INTEGER :: ifils, iq2 ! CRisi
    … …  
    452452  ! CRisi: appel récursif de l'advection sur les fils.
    453453  ! Il faut faire ça avant d'avoir mis à jour q et masse
    454   ! !write(*,*) 'vlspltqs 326: iq,nqChildren(iq)=',iq,
     454  !write(*,*) 'vlspltqs 326: iq,nqChildren(iq)=',iq,
    455455  ! &                 tracers(iq)%nqChildren
    456456
    … …  
    459459    DO l = 1, llm
    460460      DO ij = iip2, ip1jm
    461         ! ! On a besoin de q et masse seulement entre iip2 et ip1jm
     461        ! On a besoin de q et masse seulement entre iip2 et ip1jm
    462462        masseq(ij, l, iq2) = masse(ij, l, iq) * q(ij, l, iq)
    463463        Ratio(ij, l, iq2) = q(ij, l, iq2) / q(ij, l, iq)
    … …  
    488488  ENDDO
    489489
    490   ! ! retablir les fils en rapport de melange par rapport a l'air:
    491   ! ! On calcule q entre iip2+1,ip1jm -> on fait pareil pour ratio
    492   ! ! puis on boucle en longitude
     490  ! retablir les fils en rapport de melange par rapport a l'air:
     491  ! On calcule q entre iip2+1,ip1jm -> on fait pareil pour ratio
     492  ! puis on boucle en longitude
    493493  do ifils = 1, tracers(iq)%nqDescen
    494494    iq2 = tracers(iq)%iqDescen(ifils)
    … …  
    758758  ! CRisi: appel récursif de l'advection sur les fils.
    759759  ! Il faut faire ça avant d'avoir mis à jour q et masse
    760   ! !write(*,*) 'vlyqs 689: iq,nqChildren(iq)=',iq,
     760  !write(*,*) 'vlyqs 689: iq,nqChildren(iq)=',iq,
    761761  ! &              tracers(iq)%nqChildren
    762762

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/wrgrads.f90

    r5105 r5113  
    22
    33subroutine wrgrads(if, nl, field, name, titlevar)
    4   implicit none
     4  IMPLICIT NONE
    55
    66  !   Declarations
Note: See TracChangeset for help on using the changeset viewer.