Changeset 1442 for trunk/LMDZ.VENUS/libf


Ignore:
Timestamp:
Jun 4, 2015, 4:23:32 PM (10 years ago)
Author:
slebonnois
Message:

SL: update of the Venus GCM, + corrections on routines used for newstart/start2archive for Titan and Venus, + some modifications on tools

Location:
trunk/LMDZ.VENUS/libf/phyvenus
Files:
10 added
2 deleted
24 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.VENUS/libf/phyvenus/ballon.F

    r101 r1442  
    167167      phib(k)= (j-1)*20.*RPI/180.
    168168      lamb(k)= (i-3)*90.*RPI/180.   ! de -180 à 90
    169       lognb(k)= log10(5.e4/(RKBOL*300.)) ! ~55km in VIRA model
     169c     lognb(k)= log10(5.e4/(RKBOL*300.)) ! ~55km in VIRA model
     170      lognb(k)= log10(5.e5/(RKBOL*300.)) ! 5 bars (for Blamont, mai2015)
    170171      enddo
    171172      enddo

  • trunk/LMDZ.VENUS/libf/phyvenus/chemparam_mod.F90

    r1305 r1442  
    1313                 i_cocl2, i_s, i_so, i_so2, i_so3,       &
    1414                 i_s2o2, i_ocs, i_hso3, i_h2so4, i_s2,   &
    15                  i_clso2, i_oscl, i_h2oliq, i_h2so4liq
     15                 i_clso2, i_oscl, i_h2oliq, i_h2so4liq,  &
     16                 i_n2
    1617                 
    1718REAL, DIMENSION(:), SAVE, ALLOCATABLE :: M_tr
    … …  
    1920
    2021!----------------------------------------------------------------------------
    21 !     number of clouds layer modelized
    22 !      INTEGER, PARAMETER :: nbr_cloud = 1
     22!     number of clouds mode modelized
     23      INTEGER, PARAMETER :: nbr_mode = 3
    2324      INTEGER :: i_cloud
    2425      INTEGER, SAVE :: cloudmax
    2526      INTEGER, SAVE :: cloudmin
    26       REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: R_MEDIAN
    27       REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: STDDEV
    28       REAL, SAVE :: RMI
    29       REAL, SAVE :: RMA
    30       REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: NBRTOT
     27      REAL, SAVE, DIMENSION(:,:,:), ALLOCATABLE :: R_MEDIAN
     28      REAL, SAVE, DIMENSION(:,:,:), ALLOCATABLE :: STDDEV
     29     
     30!     K_MASS coefficient correspondant à la partie condensee de chaque mode
     31      REAL, SAVE, DIMENSION(:,:,:), ALLOCATABLE :: K_MASS
     32
     33      REAL, SAVE, DIMENSION(:,:,:), ALLOCATABLE :: NBRTOT
    3134      REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: WH2SO4
    3235      REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: rho_droplet
    … …  
    4447      INTEGER :: nbr_lon,nbr_lev,i_lev
    4548   
    46       ALLOCATE(NBRTOT(nbr_lon,nbr_lev))
    47       ALLOCATE(R_MEDIAN(nbr_lon,nbr_lev))
    48       ALLOCATE(STDDEV(nbr_lon,nbr_lev))
     49      ALLOCATE(NBRTOT(nbr_lon,nbr_lev,nbr_mode))
     50      ALLOCATE(R_MEDIAN(nbr_lon,nbr_lev,nbr_mode))
     51      ALLOCATE(K_MASS(nbr_lon,nbr_lev,nbr_mode))
     52      ALLOCATE(STDDEV(nbr_lon,nbr_lev,nbr_mode))
    4953      ALLOCATE(WH2SO4(nbr_lon,nbr_lev))
    5054      ALLOCATE(rho_droplet(nbr_lon,nbr_lev))
    … …  
    5559      PRINT*,'nbr_lon',nbr_lon
    5660      PRINT*,'nbr_lev',nbr_lev
    57      
     61      PRINT*,'nbr_mode',nbr_mode
     62       
     63      NBRTOT(:,:,:)    = 0.0E+0
     64      WH2SO4(:,:)      = 0.0E+0
     65      rho_droplet(:,:) = 0.0E+0
     66           
    5867!=============================================================
    5968!                     Initialisation cloud layer 1
    6069!=============================================================
    6170!     cloudmin et cloudmax niveaux du GCM
    62       cloudmin= 15
     71      cloudmin= 18
    6372      cloudmax= 50
    64 !     radius min et max en microns, *e-6 dans cloud_venus -> SETBIN
    65 !      RMI=0.001
    66 !      RMA=100.0
    67 !      NBRTOT= 0.
    6873
    6974!     radius R_MEDIAN en m (donc *e-6 pour microns)
    7075       
    71         R_MEDIAN(:,:)=0.0               ! Geometric Average Radius
    72         STDDEV(:,:)=0.0 ! Geometric Std Deviation
     76        R_MEDIAN(:,:,:)=0.0E+0             ! Geometric Average Radius
     77        STDDEV(:,:,:)=0.0E+0             ! Geometric Std Deviation
     78        K_MASS(:,:,:)=0.0E+0             ! Coeff multimodal
    7379
    7480!       ===============================================
    … …  
    7682!       ===============================================
    7783
     84!       ===============================================
     85!       Initialisation UNIMODALE
     86!       ===============================================
     87
    7888!     Lower Haze: mode 1
    79       DO i_lev=cloudmin,20
    80       R_MEDIAN(:,i_lev)=0.2e-6
    81       PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev)
    82       STDDEV(:,i_lev)=1.56
    83       PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev)
    84       END DO
    85        
    86 !     Lower Cloud: mode 2
     89!      DO i_lev=cloudmin,20
     90!      R_MEDIAN(:,i_lev,1)=0.2e-6
     91!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     92!      STDDEV(:,i_lev,1)=1.56
     93!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     94!      K_MASS(:,i_lev,1)=1.0
     95!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     96!      END DO
     97
     98!     Lower Cloud: mode 3
    8799!      DO i_lev=21,23
    88 !      R_MEDIAN(:,i_lev)=1.4e-6
    89 !      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev)
    90 !      STDDEV(:,i_lev)=1.23
    91 !      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev)
     100!      R_MEDIAN(:,i_lev,1)=3.65e-6
     101!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     102!      STDDEV(:,i_lev,1)=1.28
     103!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     104!      K_MASS(:,i_lev,1)=1.0
     105!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     106!      END DO
     107
     108!     Middle Cloud: mode 2 prime
     109!      DO i_lev=24,28
     110!      R_MEDIAN(:,i_lev,1)=1.4e-6
     111!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     112!      STDDEV(:,i_lev,1)=1.23
     113!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     114!      K_MASS(:,i_lev,1)=1.0
     115!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     116!      END DO
     117
     118!     Upper Cloud: mode 2
     119!      DO i_lev=29,35
     120!      R_MEDIAN(:,i_lev,1)=1.0e-6
     121!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     122!      STDDEV(:,i_lev,1)=1.29
     123!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     124!      K_MASS(:,i_lev,1)=1.0
     125!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     126!      END DO
     127
     128!     Upper Haze: mode 1
     129!      DO i_lev=36, cloudmax
     130!      R_MEDIAN(:,i_lev,1)=0.2e-6
     131!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     132!      STDDEV(:,i_lev,1)=2.16
     133!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     134!      K_MASS(:,i_lev,1)=1.0
     135!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     136!      END DO
     137
     138!       ===============================================
     139!       Initialisation TRIMODALE
     140!       ===============================================
     141
     142!     Lower Haze: mode 1
     143!      DO i_lev=cloudmin,20
     144!      R_MEDIAN(:,i_lev,1)=0.3e-6
     145!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     146!      STDDEV(:,i_lev,1)=1.56
     147!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     148!      K_MASS(:,i_lev,1)=1.0
     149!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     150!      END DO
     151                             
     152!     Lower Haze: mode 2
     153!      DO i_lev=cloudmin,20
     154!      R_MEDIAN(:,i_lev,2)=1.4e-6
     155!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     156!      STDDEV(:,i_lev,2)=1.23
     157!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     158!      K_MASS(:,i_lev,2)=0.0
     159!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
     160!      END DO
     161
     162!     Lower Haze: mode 3
     163!      DO i_lev=cloudmin,20
     164!      R_MEDIAN(:,i_lev,3)=3.65e-6
     165!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     166!      STDDEV(:,i_lev,3)=1.28
     167!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     168!      K_MASS(:,i_lev,3)=0.
     169!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
     170!      END DO 
     171
     172!     Lower Cloud: mode 1
     173!      DO i_lev=21,23
     174!      R_MEDIAN(:,i_lev,1)=0.3e-6
     175!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     176!      STDDEV(:,i_lev,1)=1.56
     177!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     178!      K_MASS(:,i_lev,1)=0.1
     179!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     180!      END DO
     181                             
     182!     Lower Cloud: mode 2 prime
     183!      DO i_lev=21,23
     184!      R_MEDIAN(:,i_lev,2)=1.4e-6
     185!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     186!      STDDEV(:,i_lev,2)=1.23
     187!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     188!      K_MASS(:,i_lev,2)=0.4
     189!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
    92190!      END DO
    93191
    94192!     Lower Cloud: mode 3
    95       DO i_lev=21,23
    96       R_MEDIAN(:,i_lev)=3.65e-6
    97       PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev)
    98       STDDEV(:,i_lev)=1.28
    99       PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev)
    100       END DO
     193!      DO i_lev=21,23
     194!      R_MEDIAN(:,i_lev,3)=3.65e-6
     195!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     196!      STDDEV(:,i_lev,3)=1.28
     197!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     198!      K_MASS(:,i_lev,3)=0.5
     199!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
     200!      END DO
     201
     202!     Middle Cloud: mode 1
     203!      DO i_lev=24,28
     204!      R_MEDIAN(:,i_lev,1)=0.3e-6
     205!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     206!      STDDEV(:,i_lev,1)=1.56
     207!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     208!      K_MASS(:,i_lev,1)=0.0
     209!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     210!      END DO
    101211         
    102212!     Middle Cloud: mode 2 prime
    103       DO i_lev=24,28
    104       R_MEDIAN(:,i_lev)=1.4e-6
    105       PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev)
    106       STDDEV(:,i_lev)=1.23
    107       PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev)
    108       END DO
     213!      DO i_lev=24,28
     214!      R_MEDIAN(:,i_lev,2)=1.4e-6
     215!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     216!      STDDEV(:,i_lev,2)=1.23
     217!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     218!      K_MASS(:,i_lev,2)=0.8
     219!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
     220!      END DO
    109221   
    110222!     Middle Cloud: mode 3
    111223!      DO i_lev=24,28
    112 !      R_MEDIAN(:,i_lev)=3.65e-6
    113 !      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev)
    114 !      STDDEV(:,i_lev)=1.28
    115 !      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev)
    116 !      END DO
    117    
    118 !     Middle Cloud: mode 4
    119 !      DO i_lev=24,28
    120 !      R_MEDIAN(:,i_lev)=7.0e-6
    121 !      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev)
    122 !      STDDEV(:,i_lev)=1.3
    123 !      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev)
    124 !      END DO
    125 
    126 !     Upper Cloud: mode 4
     224!      R_MEDIAN(:,i_lev,3)=3.65e-6
     225!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     226!      STDDEV(:,i_lev,3)=1.28
     227!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     228!      K_MASS(:,i_lev,3)=0.2
     229!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
     230!      END DO
     231
     232
     233!     Upper Cloud: mode 1
    127234!      DO i_lev=29,35
    128 !      R_MEDIAN(:,i_lev)=7.0e-6
    129 !      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev)
    130 !      STDDEV(:,i_lev)=1.3
    131 !      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev)
     235!      R_MEDIAN(:,i_lev,1)=0.3e-6
     236!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     237!      STDDEV(:,i_lev,1)=1.56
     238!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     239!      K_MASS(:,i_lev,1)=0.15
     240!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     241!      END DO
     242
     243!     Upper Cloud: mode 2
     244!      DO i_lev=29,35
     245!      R_MEDIAN(:,i_lev,2)=1.0e-6
     246!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     247!      STDDEV(:,i_lev,2)=1.29
     248!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     249!      K_MASS(:,i_lev,2)=0.85
     250!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
    132251!      END DO
    133252       
    134253!     Upper Cloud: mode 3
    135254!      DO i_lev=29,35
    136 !      R_MEDIAN(:,i_lev)=3.65e-6
    137 !      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev)
    138 !      STDDEV(:,i_lev)=1.28
    139 !      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev)
    140 !      END DO
    141            
     255!      R_MEDIAN(:,i_lev,3)=3.65e-6
     256!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     257!      STDDEV(:,i_lev,3)=1.28
     258!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     259!      K_MASS(:,i_lev,3)=0.0
     260!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
     261!      END DO
     262
     263!     Upper Haze: mode 1
     264!      DO i_lev=36, cloudmax
     265!      R_MEDIAN(:,i_lev,1)=0.3e-6
     266!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     267!      STDDEV(:,i_lev,1)=1.56
     268!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     269!      K_MASS(:,i_lev,1)=1.0
     270!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     271!      END DO
     272
     273!     Upper Haze: mode 2
     274!      DO i_lev=36, cloudmax
     275!      R_MEDIAN(:,i_lev,2)=1.e-6
     276!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     277!      STDDEV(:,i_lev,2)=1.29
     278!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     279!      K_MASS(:,i_lev,2)=0.0
     280!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
     281!      END DO
     282     
     283!     Upper Haze: mode 3
     284!      DO i_lev=36, cloudmax
     285!      R_MEDIAN(:,i_lev,3)=3.65e-6
     286!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     287!      STDDEV(:,i_lev,3)=2.16
     288!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     289!      K_MASS(:,i_lev,3)=0.0
     290!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
     291!      END DO       
     292!=============================================================
     293
     294!       ===============================================
     295!       Initialisation TRIMODALE Knollenberg
     296!       ===============================================
     297
     298!     Lower Haze: mode 1
     299      DO i_lev=cloudmin,22
     300      R_MEDIAN(:,i_lev,1)=0.1e-6
     301      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     302      STDDEV(:,i_lev,1)=1.57
     303      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     304      K_MASS(:,i_lev,1)=1.0
     305      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     306      END DO
     307                             
     308!     Lower Haze: mode 2
     309      DO i_lev=cloudmin,22
     310      R_MEDIAN(:,i_lev,2)=1.4e-6
     311      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     312      STDDEV(:,i_lev,2)=1.23
     313      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     314      K_MASS(:,i_lev,2)=0.0
     315      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
     316      END DO
     317
     318!     Lower Haze: mode 3
     319      DO i_lev=cloudmin,22
     320      R_MEDIAN(:,i_lev,3)=3.65e-6
     321      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     322      STDDEV(:,i_lev,3)=1.28
     323      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     324      K_MASS(:,i_lev,3)=0.0
     325      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
     326      END DO 
     327
     328!     Pre Cloud: mode 1
     329      DO i_lev=23,23
     330      R_MEDIAN(:,i_lev,1)=0.15e-6
     331      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     332      STDDEV(:,i_lev,1)=1.8
     333      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     334      K_MASS(:,i_lev,1)=0.04
     335      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     336      END DO
     337                             
     338!     Pre Cloud: mode 2
     339      DO i_lev=23,23
     340      R_MEDIAN(:,i_lev,2)=1.0e-6
     341      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     342      STDDEV(:,i_lev,2)=1.29
     343      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     344      K_MASS(:,i_lev,2)=0.96
     345      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
     346      END DO
     347
     348!     Pre Cloud: mode 3
     349      DO i_lev=23,23
     350      R_MEDIAN(:,i_lev,3)=3.65e-6
     351      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     352      STDDEV(:,i_lev,3)=1.28
     353      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     354      K_MASS(:,i_lev,3)=0.0
     355      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
     356      END DO
     357                 
     358!      Lower Cloud: mode 1
     359      DO i_lev=24,24
     360      R_MEDIAN(:,i_lev,1)=0.2e-6
     361      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     362      STDDEV(:,i_lev,1)=1.8
     363      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     364      K_MASS(:,i_lev,1)=0.014
     365      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     366      END DO
     367               
     368!     Lower Cloud: mode 2
     369      DO i_lev=24,24
     370      R_MEDIAN(:,i_lev,2)=1.0e-6
     371      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     372      STDDEV(:,i_lev,2)=1.29
     373      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     374      K_MASS(:,i_lev,2)=0.02
     375      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
     376      END DO
     377
     378!     Lower Cloud: mode 3
     379      DO i_lev=24,24
     380      R_MEDIAN(:,i_lev,3)=3.65e-6
     381      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     382      STDDEV(:,i_lev,3)=1.28
     383      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     384      K_MASS(:,i_lev,3)=0.966
     385      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
     386      END DO
     387
     388!     Middle Cloud: mode 1
     389      DO i_lev=25,28
     390      R_MEDIAN(:,i_lev,1)=0.15e-6
     391      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     392      STDDEV(:,i_lev,1)=1.9
     393      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     394      K_MASS(:,i_lev,1)=0.0084
     395      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     396      END DO
     397         
     398!     Middle Cloud: mode 2 prime
     399      DO i_lev=25,28
     400      R_MEDIAN(:,i_lev,2)=1.4e-6
     401      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     402      STDDEV(:,i_lev,2)=1.23
     403      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     404      K_MASS(:,i_lev,2)=0.21
     405      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
     406      END DO
     407   
     408!     Middle Cloud: mode 3
     409      DO i_lev=25,28
     410      R_MEDIAN(:,i_lev,3)=3.65e-6
     411      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     412      STDDEV(:,i_lev,3)=1.28
     413      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     414      K_MASS(:,i_lev,3)=0.7816
     415      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
     416      END DO
     417
     418
     419!     Upper Cloud: mode 1
     420      DO i_lev=29,35
     421      R_MEDIAN(:,i_lev,1)=0.2e-6
     422      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     423      STDDEV(:,i_lev,1)=2.16
     424      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     425      K_MASS(:,i_lev,1)=0.72
     426      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     427      END DO
     428
    142429!     Upper Cloud: mode 2
    143430      DO i_lev=29,35
    144       R_MEDIAN(:,i_lev)=1.0e-6
    145       PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev)
    146       STDDEV(:,i_lev)=1.29
    147       PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev)
     431      R_MEDIAN(:,i_lev,2)=1.0e-6
     432      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     433      STDDEV(:,i_lev,2)=1.29
     434      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     435      K_MASS(:,i_lev,2)=0.28
     436      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
     437      END DO
     438       
     439!     Upper Cloud: mode 3
     440      DO i_lev=29,35
     441      R_MEDIAN(:,i_lev,3)=3.65e-6
     442      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     443      STDDEV(:,i_lev,3)=1.28
     444      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     445      K_MASS(:,i_lev,3)=0.0
     446      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
    148447      END DO
    149448
    150449!     Upper Haze: mode 1
    151450      DO i_lev=36, cloudmax
    152       R_MEDIAN(:,i_lev)=0.2e-6
    153       PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev)
    154       STDDEV(:,i_lev)=2.16
    155       PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev)
    156       END DO
    157        
     451      R_MEDIAN(:,i_lev,1)=0.2e-6
     452      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     453      STDDEV(:,i_lev,1)=2.16
     454      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     455      K_MASS(:,i_lev,1)=1.0
     456      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     457      END DO
     458
     459!     Upper Haze: mode 2
     460      DO i_lev=36, cloudmax
     461      R_MEDIAN(:,i_lev,2)=1.e-6
     462      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     463      STDDEV(:,i_lev,2)=1.29
     464      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     465      K_MASS(:,i_lev,2)=0.0
     466      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
     467      END DO
     468     
     469!     Upper Haze: mode 3
     470      DO i_lev=36, cloudmax
     471      R_MEDIAN(:,i_lev,3)=3.65e-6
     472      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     473      STDDEV(:,i_lev,3)=2.16
     474      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     475      K_MASS(:,i_lev,3)=0.0
     476      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
     477      END DO       
     478
    158479!=============================================================
    159480
     481!       ===============================================================
     482!       Initialisation TRIMODALE "Knollenberg" sans Mode3, Mode2 etendu
     483!       ===============================================================
     484
     485!     Lower Haze: mode 1
     486!      DO i_lev=cloudmin,22
     487!      R_MEDIAN(:,i_lev,1)=0.1e-6
     488!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     489!      STDDEV(:,i_lev,1)=1.57
     490!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     491!      K_MASS(:,i_lev,1)=1.0
     492!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     493!      END DO
     494                             
     495!     Lower Haze: mode 2
     496!      DO i_lev=cloudmin,22
     497!      R_MEDIAN(:,i_lev,2)=1.4e-6
     498!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     499!      STDDEV(:,i_lev,2)=1.23
     500!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     501!      K_MASS(:,i_lev,2)=0.0
     502!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
     503!      END DO
     504
     505!     Lower Haze: mode 3
     506!      DO i_lev=cloudmin,22
     507!      R_MEDIAN(:,i_lev,3)=3.65e-6
     508!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     509!      STDDEV(:,i_lev,3)=1.28
     510!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     511!      K_MASS(:,i_lev,3)=0.0
     512!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
     513!      END DO 
     514
     515!     Pre Cloud: mode 1
     516!      DO i_lev=23,23
     517!      R_MEDIAN(:,i_lev,1)=0.15e-6
     518!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     519!      STDDEV(:,i_lev,1)=1.8
     520!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     521!      K_MASS(:,i_lev,1)=0.04
     522!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     523!      END DO
     524                             
     525!     Pre Cloud: mode 2
     526!      DO i_lev=23,23
     527!      R_MEDIAN(:,i_lev,2)=1.0e-6
     528!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     529!      STDDEV(:,i_lev,2)=1.29
     530!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     531!      K_MASS(:,i_lev,2)=0.96
     532!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
     533!      END DO
     534
     535!     Pre Cloud: mode 3
     536!      DO i_lev=23,23
     537!      R_MEDIAN(:,i_lev,3)=3.65e-6
     538!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     539!      STDDEV(:,i_lev,3)=1.28
     540!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     541!      K_MASS(:,i_lev,3)=0.0
     542!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
     543!      END DO
     544                 
     545!      Lower Cloud: mode 1
     546!      DO i_lev=24,24
     547!      R_MEDIAN(:,i_lev,1)=0.2e-6
     548!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     549!      STDDEV(:,i_lev,1)=1.8
     550!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     551!      K_MASS(:,i_lev,1)=0.014
     552!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     553!      END DO
     554               
     555!     Lower Cloud: mode 2
     556!      DO i_lev=24,24
     557!      R_MEDIAN(:,i_lev,2)=1.0e-6
     558!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     559!      STDDEV(:,i_lev,2)=1.6
     560!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     561!      K_MASS(:,i_lev,2)=0.986
     562!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
     563!      END DO
     564
     565!     Lower Cloud: mode 3
     566!      DO i_lev=24,24
     567!      R_MEDIAN(:,i_lev,3)=3.65e-6
     568!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     569!      STDDEV(:,i_lev,3)=1.28
     570!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     571!      K_MASS(:,i_lev,3)=0.
     572!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
     573!      END DO
     574
     575!     Middle Cloud: mode 1
     576!      DO i_lev=25,28
     577!      R_MEDIAN(:,i_lev,1)=0.15e-6
     578!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     579!      STDDEV(:,i_lev,1)=1.9
     580!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     581!      K_MASS(:,i_lev,1)=0.0084
     582!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     583!      END DO
     584         
     585!     Middle Cloud: mode 2 prime
     586!      DO i_lev=25,28
     587!      R_MEDIAN(:,i_lev,2)=1.4e-6
     588!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     589!      STDDEV(:,i_lev,2)=1.6
     590!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     591!      K_MASS(:,i_lev,2)=0.9916
     592!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
     593!      END DO
     594   
     595!     Middle Cloud: mode 3
     596!      DO i_lev=25,28
     597!      R_MEDIAN(:,i_lev,3)=3.65e-6
     598!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     599!      STDDEV(:,i_lev,3)=1.28
     600!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     601!      K_MASS(:,i_lev,3)=0.0
     602!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
     603!      END DO
     604
     605
     606!     Upper Cloud: mode 1
     607!      DO i_lev=29,35
     608!      R_MEDIAN(:,i_lev,1)=0.2e-6
     609!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     610!      STDDEV(:,i_lev,1)=2.16
     611!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     612!      K_MASS(:,i_lev,1)=0.72
     613!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     614!      END DO
     615
     616!     Upper Cloud: mode 2
     617!      DO i_lev=29,35
     618!      R_MEDIAN(:,i_lev,2)=1.0e-6
     619!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     620!      STDDEV(:,i_lev,2)=1.29
     621!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     622!      K_MASS(:,i_lev,2)=0.28
     623!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
     624!      END DO
     625       
     626!     Upper Cloud: mode 3
     627!      DO i_lev=29,35
     628!      R_MEDIAN(:,i_lev,3)=3.65e-6
     629!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     630!      STDDEV(:,i_lev,3)=1.28
     631!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     632!      K_MASS(:,i_lev,3)=0.0
     633!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
     634!      END DO
     635
     636!     Upper Haze: mode 1
     637!      DO i_lev=36, cloudmax
     638!      R_MEDIAN(:,i_lev,1)=0.2e-6
     639!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,1)
     640!      STDDEV(:,i_lev,1)=2.16
     641!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,1)
     642!      K_MASS(:,i_lev,1)=1.0
     643!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,1)
     644!      END DO
     645
     646!     Upper Haze: mode 2
     647!      DO i_lev=36, cloudmax
     648!      R_MEDIAN(:,i_lev,2)=1.e-6
     649!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,2)
     650!      STDDEV(:,i_lev,2)=1.29
     651!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,2)
     652!      K_MASS(:,i_lev,2)=0.0
     653!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,2)
     654!      END DO
     655     
     656!     Upper Haze: mode 3
     657!      DO i_lev=36, cloudmax
     658!      R_MEDIAN(:,i_lev,3)=3.65e-6
     659!      PRINT*,'level',i_lev,'R R_MEDIAN',R_MEDIAN(1,i_lev,3)
     660!      STDDEV(:,i_lev,3)=2.16
     661!      PRINT*,'level',i_lev,'Dev Std',STDDEV(1,i_lev,3)
     662!      K_MASS(:,i_lev,3)=0.0
     663!      PRINT*,'level',i_lev,'Coeff Mass: k_mass',K_MASS(1,i_lev,3)
     664!      END DO       
     665!=============================================================
    160666      PRINT*,'==============================='
    161667      PRINT*,'FIN Initialisation cloud layer'
    162668      PRINT*,'==============================='
    163669     
    164         END SUBROUTINE
     670  END SUBROUTINE cloud_ini
    165671 
    166672  SUBROUTINE chemparam_ini
    … …  
    313819                PRINT*,'h2so4liq',i_h2so4liq
    314820                M_tr(i_h2so4liq)=98.078
     821                CASE('n2')
     822                i_n2=i
     823                M_tr(i_n2)=28.013
    315824        END SELECT
    316825       

  • trunk/LMDZ.VENUS/libf/phyvenus/clesphys.h

    r1310 r1442  
    1212       LOGICAL ok_kzmin
    1313       LOGICAL callnlte,callnirco2,callthermos
    14        LOGICAL ok_cloud, ok_chem, reinit_trac, ok_sedim
     14       LOGICAL ok_cloud, ok_chem, reinit_trac, ok_sedim, ok_deltatemp
    1515       INTEGER nbapp_rad, nbapp_chim, iflag_con, iflag_ajs
    1616       INTEGER lev_histins, lev_histday, lev_histmth
    … …  
    2222       REAL    ksta, inertie
    2323       REAL    euveff, solarcondate
     24       INTEGER nb_mode
    2425
    2526       COMMON/clesphys_l/ cycle_diurne, soil_model,                     &
    2627     &     ok_orodr, ok_orolf, ok_gw_nonoro, ok_kzmin,                  &
    2728     &     callnlte,callnirco2,callthermos,                             &
    28      &     ok_cloud, ok_chem, reinit_trac, ok_sedim
     29     &     ok_cloud, ok_chem, reinit_trac, ok_sedim, ok_deltatemp
    2930
    3031       COMMON/clesphys_i/ nbapp_rad, nbapp_chim,                        &
    3132     &     iflag_con, iflag_ajs,                                        &
    3233     &     lev_histins, lev_histday, lev_histmth, tr_scheme,            &
    33      &     nircorr, nltemodel, solvarmod
     34     &     nircorr, nltemodel, solvarmod, nb_mode
    3435
    3536       COMMON/clesphys_r/ ecriphy, solaire, z0, lmixmin,                &

  • trunk/LMDZ.VENUS/libf/phyvenus/cltrac.F

    r101 r1442  
    121121c ATTENTION SHUNTE!!!!!!
    122122
    123       DO k = 1, klev
    124       DO i = 1, klon
    125          d_tr(i,k) = 0.
    126       ENDDO
    127       ENDDO
     123c      DO k = 1, klev
     124c      DO i = 1, klon
     125c         d_tr(i,k) = 0.
     126c      ENDDO
     127c      ENDDO
    128128
    129129      RETURN

  • trunk/LMDZ.VENUS/libf/phyvenus/comcstVE.h

    r1301 r1442  
    44        integer nnuve,nbmat
    55        parameter (nnuve=68)  ! fichiers Vincent et Bullock
    6         parameter (nbmat=210) ! Max number of matrixes in Vincent's file
     6!       parameter (nnuve=598)  ! fichiers Vincent et Bullock
     7        parameter (nbmat=220) ! Max number of matrixes in Vincent's file
    78
    89      common/comcstVE/al,bl,nlatve,indexve,nbpsve,nbszave,               &

  • trunk/LMDZ.VENUS/libf/phyvenus/concentrations2.F

    r1310 r1442  
    1       SUBROUTINE concentrations2(pplay,t_seri,pdt,co2vmr_gcm, n2vmr_gcm,
    2      $   covmr_gcm,o3pvmr_gcm,nvmr_gcm,ptimestep)
     1      SUBROUTINE concentrations2(pplay,t_seri,pdt,tr_seri, nqmx,
     2     $                        ptimestep)
    33
    44      use dimphy
    55      use conc,  only: mmean, Akknew, rnew, cpnew
    66      use cpdet_mod, only: cpdet                       
     7      USE chemparam_mod
     8      use infotrac
     9
    710      implicit none
    811
    … …  
    2629c#include "chimiedata.h"
    2730c#include "tracer.h"
    28 #include "mmol.h"
     31c#include "mmol.h"
    2932
    3033!     input/output
    … …  
    3235      real pplay(klon,klev)
    3336c      real pt(klon,klev)
     37      integer,intent(in) :: nqmx    ! number of tracers
    3438      real t_seri(klon, klev)
    3539      real pdt(klon,klev)
    36       real co2vmr_gcm(klon,klev), n2vmr_gcm(klon,klev)
    37       real covmr_gcm(klon,klev)
    38       real o3pvmr_gcm(klon,klev),nvmr_gcm(klon,klev)
    39 c      real pq(klon,klev,nqmx)
     40      real n2vmr_gcm(klon,klev),nvmr_gcm(klon,klev)
     41      real tr_seri(klon,klev,nqmx)
    4042c      real pdq(klon,klev,nqmx)
    4143      real ptimestep
    … …  
    4446
    4547      integer       :: i, l, ig, iq
    46       real          :: ntot
     48      integer, save :: nbq
     49      integer,allocatable,save :: niq(:)
     50      real          :: ni(nqmx), ntot
    4751      real          :: zt(klon, klev)
    48       real, save    :: akico2,akio,akin2,akico
    49       real, save    :: akin
    50       real, save    :: cpico2,cpico,cpio,cpin2
    51       real, save    :: cpio2
     52      real          :: zq(klon, klev, nqmx)
     53      real,allocatable,save    :: aki(:)
     54      real,allocatable,save    :: cpi(:)
     55      real, save    :: akin,akin2
    5256
    5357      logical, save :: firstcall = .true.
    … …  
    5862!        values are taken from the literature [J/kg K]
    5963
    60  !          co2
    61             akico2 = 3.072e-4
    62             cpico2 = 0.834e3
    63 
    64  !       co
    65             akico = 4.87e-4
    66             cpico = 1.034e3
    67 
    68  !        o
    69             akio = 7.59e-4
    70             cpio = 1.3e3
    71 
    72  !       n
    73  !           akin = 0.0
    74  !           cpin = 0.0
     64         ! allocate local saved arrays:
     65         allocate(aki(nqmx))
     66         allocate(cpi(nqmx))
     67         allocate(niq(nqmx))
     68
     69!        find index of chemical tracers to use
     70!        initialize thermal conductivity and specific heat coefficients
     71!        !? values are estimated
     72
     73         nbq = 0 ! to count number of tracers used in this subroutine
     74
     75         if (i_co2 /= 0) then
     76            nbq = nbq + 1
     77            niq(nbq) = i_co2
     78            aki(nbq) = 3.072e-4
     79            cpi(nbq) = 0.834e3
     80         end if
     81         if (i_co /= 0) then
     82            nbq = nbq + 1
     83            niq(nbq) = i_co
     84            aki(nbq) = 4.87e-4
     85            cpi(nbq) = 1.034e3
     86         end if
     87         if (i_o /= 0) then
     88            nbq = nbq + 1
     89            niq(nbq) = i_o
     90            aki(nbq) = 7.59e-4
     91            cpi(nbq) = 1.3e3
     92         end if
     93         if (i_o1d /= 0) then
     94            nbq = nbq + 1
     95            niq(nbq) = i_o1d
     96            aki(nbq) = 7.59e-4  !?
     97            cpi(nbq) = 1.3e3    !?
     98         end if
     99         if (i_o2 /= 0) then
     100            nbq = nbq + 1
     101            niq(nbq) = i_o2
     102            aki(nbq) = 5.68e-4
     103            cpi(nbq) = 0.9194e3
     104         end if
     105         if (i_o3 /= 0) then
     106            nbq = nbq + 1
     107            niq(nbq) = i_o3
     108            aki(nbq) = 3.00e-4  !?
     109            cpi(nbq) = 0.800e3  !?
     110         end if
     111         if (i_h /= 0) then
     112            nbq = nbq + 1
     113            niq(nbq) = i_h
     114            aki(nbq) = 0.0
     115            cpi(nbq) = 20.780e3
     116         end if
     117         if (i_h2 /= 0) then
     118            nbq = nbq + 1
     119            niq(nbq) = i_h2
     120            aki(nbq) = 36.314e-4
     121            cpi(nbq) = 14.266e3
     122         end if
     123         if (i_oh /= 0) then
     124            nbq = nbq + 1
     125            niq(nbq) = i_oh
     126            aki(nbq)  = 7.00e-4 !?
     127            cpi(nbq)  = 1.045e3
     128         end if
     129         if (i_ho2 /= 0) then
     130            nbq = nbq + 1
     131            niq(nbq) = i_ho2
     132            aki(nbq) = 0.0
     133            cpi(nbq) = 1.065e3  !?
     134         end if
     135         if (i_n2 /= 0) then
     136            nbq = nbq + 1
     137            niq(nbq) = i_n2
     138            aki(nbq) = 5.6e-4
     139            cpi(nbq) = 1.034e3
     140         end if
     141c         if (i_ar /= 0) then
     142c            nbq = nbq + 1
     143c            niq(nbq) = i_ar
     144c            aki(nbq) = 0.0      !?
     145c            cpi(nbq) = 1.000e3  !?
     146c         end if
     147         if (i_h2o /= 0) then
     148            nbq = nbq + 1
     149            niq(nbq) = i_h2o
     150            aki(nbq) = 0.0
     151            cpi(nbq) = 1.870e3
     152         end if
     153c         if (i_n /= 0) then
     154c            nbq = nbq + 1
     155c            niq(nbq) = i_n
     156c            aki(nbq) = 0.0
     157c            cpi(nbq) = 0.0
     158c         endif
     159c         if(i_no /= 0) then
     160c            nbq = nbq + 1
     161c            niq(nbq) = i_no
     162c            aki(nbq) = 0.0
     163c            cpi(nbq) = 0.0
     164c         endif
     165c         if(i_no2 /= 0) then
     166c            nbq = nbq + 1
     167c            niq(nbq) = i_no2
     168c            aki(nbq) = 0.0
     169c            cpi(nbq) = 0.0
     170c         endif
     171c         if(i_n2d /= 0) then
     172c            nbq = nbq + 1
     173c            niq(nbq) = i_n2d
     174c            aki(nbq) = 0.0
     175c            cpi(nbq) = 0.0
     176c         endif
    75177
    76178  !     n2
    77             akin2 = 5.6e-4
    78             cpin2 = 1.034e3
     179c            akin2 = 5.6e-4
     180c            cpin2 = 1.034e3
     181
     182
     183         
     184         ! tell the world about it:
     185         write(*,*) "concentrations: firstcall, nbq=",nbq
     186!         write(*,*) "  niq(1:nbq)=",niq(1:nbq)
     187!         write(*,*) "  aki(1:nbq)=",aki(1:nbq)
     188!         write(*,*) "  cpi(1:nbq)=",cpi(1:nbq)
     189
    79190
    80191         firstcall = .false.
    … …  
    85196      do l = 1,klev
    86197         do ig = 1,klon
    87 c            zt(ig,l) = pt(ig,l) + pdt(ig,l)*ptimestep
    88198            zt(ig,l) = t_seri(ig,l)
    89 
    90199         end do
    91200      end do
    92201
     202
     203!     update mass mixing ratio tracers
     204
     205      do l = 1,klev
     206         do ig = 1,klon
     207            do i = 1,nqmx
     208!               iq = niq(i)
     209               zq(ig,l,i) = max(1.e-30, tr_seri(ig,l,i))
     210            end do
     211         end do
     212      end do
     213
    93214!     mmean : mean molecular mass
    94215!     rnew  : specific gas constant
    … …  
    98219      do l = 1,klev
    99220         do ig = 1,klon
    100 c            do i = 1,nbq
    101 c               iq = niq(i)
    102 c               mmean(ig,l) = mmean(ig,l) + zq(ig,l,iq)/mmol(iq)
    103 c            end do
    104             mmean(ig,l) = RMD
     221            do i = 1,nqmx
     222               iq = niq(i)
     223               mmean(ig,l) = mmean(ig,l) + zq(ig,l,i)/M_tr(i)
     224            end do
     225c            mmean(ig,l) = RMD
     226            mmean(ig,l) = 1./mmean(ig,l)
    105227            rnew(ig,l) = 8.314/mmean(ig,l)*1.e3     ! J/kg K           
     228 
     229c            write(*,*),'Mmean: ',ig, l, mmean(0,l)
    106230         end do
    107231      end do
    … …  
    110234!     akknew : thermal conductivity cofficient
    111235     
    112 c      cpnew(:,:)  = 0.
    113 c      akknew(:,:) = 0.
     236      cpnew(:,:)  = 0.
     237      akknew(:,:) = 0.
    114238
    115239      do l = 1,klev
    … …  
    118242            ntot = pplay(ig,l)/(RKBOL*zt(ig,l))*1.e-6  ! in #/cm3
    119243
    120             cpnew(ig,l) = ntot*o3pvmr_gcm(ig,l)*cpio
    121      $              +ntot* co2vmr_gcm(ig,l)*cpdet(zt(ig,l))             
    122      $         + ntot*n2vmr_gcm(ig,l)*cpin2 + ntot*covmr_gcm(ig,l)*cpico   
    123 
    124 
    125             akknew(ig,l) = ntot*o3pvmr_gcm(ig,l)*akio +
    126      $               ntot*co2vmr_gcm(ig,l)*akico2 +
    127      $           ntot*n2vmr_gcm(ig,l)*akin2 + ntot*covmr_gcm(ig,l)*akico         
    128 
     244!!! --- INSERT N2 values ----
     245!!  WARNING -> Cp here below doesn't depend on T (cpdet)
     246
     247            do i = 1,nbq
     248c               iq = niq(i)
     249               ni(i) = ntot*zq(ig,l,i)*mmean(ig,l)/M_tr(i)
     250               cpnew(ig,l) = cpnew(ig,l) + ni(i)*cpi(i)
     251               akknew(ig,l) = akknew(ig,l) + ni(i)*aki(i)
     252            end do
     253 
    129254
    130255            cpnew(ig,l) = cpnew(ig,l)/ntot
    131256            akknew(ig,l)= akknew(ig,l)/ntot
    132257
    133 c        print*, '--- concentrations ---'
    134 c        print*, l, cpnew(1,l),  rnew(1,l), akknew(1,l)
     258
    135259          end do
    136260       end do
    137 c       STOP
    138261
    139262      return

  • trunk/LMDZ.VENUS/libf/phyvenus/conf_phys.F90

    r1310 r1442  
    3838
    3939!Config  Key  = cycle_diurne
    40 !Config  Desc = Cycle ddiurne
     40!Config  Desc = Cycle diurne
    4141!Config  Def  = y
    4242!Config  Help = Cette option permet d'eteidre le cycle diurne.
    … …  
    361361  ok_sedim = .FALSE.
    362362  call getin('ok_sedim',ok_sedim)
    363  
     363
     364!
     365!Config Key  = ok_deltatemp
     366!Config Desc = 
     367!Config Def  = .FALSE.
     368!Config Help =
     369!
     370  ok_deltatemp = .FALSE.
     371  call getin('ok_deltatemp',ok_deltatemp)
     372
     373!
     374!Config Key  = nb_mode
     375!Config Desc = 
     376!Config Def  = 0
     377!Config Help =
     378!
     379  nb_mode = 0
     380  call getin('nb_mode',nb_mode)
     381 
    364382!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    365383! PARAMETER FOR NLTE PHYSICS
    … …  
    422440!Config Key  = solarcondate
    423441!Config Desc =
    424 !Config Def  = 1993.4
     442!Config Def  = 1993.4  ## Average solar cycle condition
    425443!Config Help =
    426444!
    … …  
    484502  write(numout,*)' ok_chem = ',ok_chem
    485503  write(numout,*)' ok_sedim = ',ok_sedim
     504  write(numout,*)' ok_deltatemp = ',ok_deltatemp
     505  write(numout,*)' nb_mode = ',nb_mode
    486506  write(numout,*)' callnlte = ',callnlte
    487507  write(numout,*)' nltemodel = ',nltemodel

  • trunk/LMDZ.VENUS/libf/phyvenus/dyn1d/rcm1d.F

    r1403 r1442  
    88      use cpdet_mod, only: ini_cpdet
    99      use moyzon_mod, only: tmoy
     10      USE comvert_mod, ONLY: ap,bp,presnivs,pa,preff,nivsigs,nivsig,
     11     .                       aps,bps,scaleheight,pseudoalt,
     12     .                       disvert_type,pressure_exner
    1013
    1114      IMPLICIT NONE
    … …  
    3033#include "dimsoil.h"
    3134#include "comcstfi.h"
    32 #include "comvert.h"
    3335#include "netcdf.inc"
    3436#include "logic.h"
    … …  
    7779      character*2 str2
    7880
    79 c normalement dans dyn3d/comconst.h
     81c normalement dans dyn3d/comconst_mod.F90
    8082      COMMON/cpdetvenus/cppdyn,nu_venus,t0_venus
    8183      REAL cppdyn,nu_venus,t0_venus

  • trunk/LMDZ.VENUS/libf/phyvenus/euvheat.F90

    r1310 r1442  
    1       SUBROUTINE euvheat(nlon, nlev, pt,pplev,pplay,zzlay, &
     1      SUBROUTINE euvheat(nlon, nlev,nqmx, pt,pplev,pplay,zzlay, &
    22                   mu0,ptimestep,ptime,zday,       &
    3                 co2vmr_gcm, n2vmr_gcm, covmr_gcm,  &
    4                 o3pvmr_gcm,nvmr_gcm,pdteuv)
    5 
     3                   pq, pdq, pdteuv)
     4
     5        use chemparam_mod
    66        use dimphy
    77        use conc, only:  rnew, cpnew
     8
    89      IMPLICIT NONE
    910!=======================================================================
    … …  
    3132!    ------------------
    3233!
    33 #include "dimensions.h"
     34!#include "dimensions.h"
    3435#include "YOMCST.h"
    3536#include "clesphys.h"
    36 !#include "comdiurn.h"
    3737#include "param.h"
    3838#include "param_v4.h"
    3939!#include "chimiedata.h"
    40 !#include "tracer.h"
    4140#include "mmol.h"
    4241!-----------------------------------------------------------------------
    … …  
    4746      integer :: nlon
    4847      integer :: nlev
     48      integer :: nqmx
    4949
    5050      real :: pt(nlon,nlev)
    … …  
    5656      real :: ptimestep,ptime
    5757      real :: zday
    58 !      real :: pq(nlon,nlev,nqmx)
    59 !      real :: pdq(nlon,nlev,nqmx)
    60       real :: co2vmr_gcm(nlon,nlev), n2vmr_gcm(nlon,nlev)
    61       real :: covmr_gcm(nlon,nlev), o3pvmr_gcm(nlon,nlev)
    62       real :: nvmr_gcm(nlon,nlev)
     58      real :: pq(nlon,nlev,nqmx)
     59      real :: pdq(nlon,nlev,nqmx)
    6360      real :: pdteuv(nlon,nlev)
    6461!
    6562!    Local variables :
    6663!    -----------------
    67       integer,save :: nespeuv=17    ! Number of species considered (11, 12 or 17)
     64
     65      integer,save :: nespeuv=17    ! Number of species considered (11, 12 or 17 (with nitrogen))
     66      integer,save :: nspeuv_vgcm    ! Number of species considered currently considered into VGCM
     67
    6868
    6969      INTEGER :: l,ig,n
    70       integer,save :: euvmod = 0    !0: Hedin profiles 5 species 1: O3 chemistry 2: N chemistry, 3: C/O/H
    71       real, allocatable :: rm(:,:)   !  number density (cm-3)
    72 !      real :: zq(nlon,nlev,nqmx) ! local updated tracer quantity
     70      integer,save :: euvmod = 0     !0: 4 (main) species 1: O3 chemistry 2: N chemistry, 3: C/O/H
     71      real, allocatable, save :: rm(:,:)   !  number density (cm-3)
     72      real :: zq(nlon,nlev,nqmx) ! local updated tracer quantity
    7373      real :: zt(nlon,nlev)      ! local updated atmospheric temperature
    7474      real :: zlocal(nlev)
    … …  
    8282!!! If the values are changed there, the same has to be done here  !!!
    8383     
    84       integer,parameter :: i_co2=1
    85       integer,parameter :: i_o=3
    86       integer,parameter :: i_co=4
    87       integer,parameter :: i_n2=13
    88       integer,parameter :: i_n=14
    89 
    90 !      integer,parameter :: i_o2=2
    91 !      integer,parameter :: i_h=5
    92 !      integer,parameter :: i_oh=6
    93 !      integer,parameter :: i_ho2=7
    94 !      integer,parameter :: i_h2=8
    95 !      integer,parameter :: i_h2o=9
    96 !      integer,parameter :: i_h2o2=10
    97 !      integer,parameter :: i_o1d=11
    98 !      integer,parameter :: i_o3=12
    99 !      integer,parameter :: i_no=15
    100 !      integer,parameter :: i_n2d=16
    101 !      integer,parameter :: i_no2=17
    102 
     84      integer,parameter :: ix_co2=1
     85      integer,parameter :: ix_o=3
     86      integer,parameter :: ix_co=4
     87      integer,parameter :: ix_n2=13
     88
     89
     90! Tracer indexes in the GCM:
     91      integer,save :: g_co2=0
     92      integer,save :: g_o=0
     93      integer,save :: g_co=0
     94      integer,save :: g_n2=0
    10395     
    104 ! Tracer indexes in the GCM:
    105 !      integer,save :: g_co2=0
    106 !      integer,save :: g_o=0
    107 !      integer,save :: g_o2=0
    108 !      integer,save :: g_h2=0
    109 !      integer,save :: g_h2o2=0
    110 !      integer,save :: g_h2o=0
    111 !      integer,save :: g_o3=0
    112 !      integer,save :: g_n2=0
    113 !      integer,save :: g_n=0
    114 !      integer,save :: g_no=0
    115 !      integer,save :: g_co=0
    116 !      integer,save :: g_h=0
    117 !      integer,save :: g_no2=0
    118 !      integer,save :: g_oh=0
    119 !      integer,save :: g_ho2=0
    120 !      integer,save :: g_o1d=0
    121 !      integer,save :: g_n2d=0
    122 
    123 
    12496      logical,save :: firstcall=.true.
    12597
    … …  
    12799
    128100
    129 !      if (firstcall) then
    130 !         nespeuv=0
    131         ! identify the indexes of the tracers we'll need
    132 !         g_co2=igcm_co2
    133 !         if (g_co2.eq.0) then
    134 !            write(*,*) "euvheat: Error; no CO2 tracer !!!"
    135 !            write(*,*) "CO2 is always needed if calleuv=.true."
    136 !            stop
    137 !         else
    138 !            nespeuv=nespeuv+1
    139 !         endif
    140 !         g_o=igcm_o
    141 !         if (g_o.eq.0) then
    142 !            write(*,*) "euvheat: Error; no O tracer !!!"
     101      if (firstcall) then
     102         nspeuv_vgcm=0
     103!        ! identify the indexes of the tracers we'll need
     104         g_co2=i_co2
     105         if (g_co2.eq.0) then
     106            write(*,*) "euvheat: Error; no CO2 tracer !!!"
     107            write(*,*) "CO2 is always needed if calleuv=.true."
     108            stop
     109         else
     110            nspeuv_vgcm=nspeuv_vgcm+1
     111         endif
     112         g_o=i_o
     113         if (g_o.eq.0) then
     114            write(*,*) "euvheat: Error; no O tracer !!!"
    143115!            write(*,*) "O is always needed if calleuv=.true."
    144 !            stop
    145 !         else
    146 !            nespeuv=nespeuv+1
    147 !         endif
     116            stop
     117         else
     118           nspeuv_vgcm=nspeuv_vgcm+1
     119         endif
     120         g_co=i_co
     121         if (g_co.eq.0) then
     122            write(*,*) "euvheat: Error; no CO tracer !!!"
     123!            write(*,*) "CO is always needed if calleuv=.true."
     124            stop
     125         else
     126            nspeuv_vgcm=nspeuv_vgcm+1
     127         endif
     128         ! n2
     129         g_n2=i_n2
     130            if (g_n2.eq.0) then
     131               write(*,*) "euvheat: Error; no N2 tracer !!!"
     132!               write(*,*) "N2 needed if NO is in traceur.def"
     133               stop
     134            else
     135               nspeuv_vgcm=nspeuv_vgcm+1
     136            endif
     137
    148138!         g_o2=igcm_o2
    149139!         if (g_o2.eq.0) then
    … …  
    201191!         else
    202192!            nespeuv=nespeuv+1 
    203 !         endif
    204 !         g_co=igcm_co
    205 !         if (g_co.eq.0) then
    206 !            write(*,*) "euvheat: Error; no CO tracer !!!"
    207 !            write(*,*) "CO is always needed if calleuv=.true."
    208 !            stop
    209 !         else
    210 !            nespeuv=nespeuv+1
    211193!         endif
    212194!         g_h=igcm_h
    … …  
    242224!            euvmod=2
    243225!         endif
    244          ! n2
    245 !         g_n2=igcm_n2
    246 !         if(euvmod.eq.2) then
    247 !            if (g_n2.eq.0) then
    248 !               write(*,*) "euvheat: Error; no N2 tracer !!!"
    249 !               write(*,*) "N2 needed if NO is in traceur.def"
    250 !               stop
    251 !            else
    252 !               nespeuv=nespeuv+1
    253 !            endif
    254 !         endif  ! Of if(euvmod.eq.2)
    255226         ! N
    256227!         g_n=igcm_n
    … …  
    332303!            endif
    333304!         end select
    334        
    335          firstcall= .false.
    336 !      endif                     ! of if (firstcall)
    337 
    338 !cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    339 
    340       !Number of species if not firstcall
    341305
    342306
    343307      !Allocate density vector
    344308      allocate(rm(nlev,nespeuv))
     309
     310         firstcall= .false.
     311      endif                     ! of if (firstcall)
     312
     313!      write(*,*),  "CHECK n species currently used into VGCM",  nspeuv_vgcm
     314
     315
     316!cccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     317
    345318      ! build local updated values of tracers (if any) and temperature
     319
    346320      do l=1,nlev
    347321        do ig=1,nlon
     322
    348323! chemical species
    349 !          zq(ig,l,g_co2)=pq(ig,l,g_co2)+pdq(ig,l,g_co2)*ptimestep
    350 ! ..... (no tracers yet) ///
    351 
    352   ! atmospheric temperature
    353 !          zt(ig,l)=pt(ig,l)+pdt(ig,l)*ptimestep
     324          zq(ig,l,g_co2)=pq(ig,l,g_co2) 
     325          zq(ig,l,g_co)=pq(ig,l,g_co)   
     326          zq(ig,l,g_o)=pq(ig,l,g_o)     
     327          zq(ig,l,g_n2)=pq(ig,l,g_n2)   
     328
     329! atmospheric temperature
    354330         zt(ig,l)=pt(ig,l)
     331
     332!      write(*,*),  "CHECK update densities L332 euv",   zq(ig,l,g_co2)
     333
     334
    355335        enddo
    356336      enddo
    … …  
    369349         
    370350         do l=1,nlev
    371             !Conversion to number density
    372 
    373 !! VERS 1 use universal gas constant R = kb * Na
    374 !           dens=pplay(ig,l)/(RKBOL*zt(ig,l)*1.e6)               !  (1.e6: [m-3] ---> [cm-3]
    375 
    376 !          rm(l,i_co2)  = co2vmr_gcm(ig,l) * dens 
    377 !           rm(l,i_o)    =  o3pvmr_gcm(ig,l) *dens   
    378 !           rm(l,i_co)   = covmr_gcm(ig,l) * dens 
    379 !           rm(l,i_n2)   = n2vmr_gcm(ig,l) * dens 
    380 !          rm(l,i_n)    = nvmr_gcm(ig,l)  * dens 
    381 
    382 
     351         
     352!   Conversion to number density
    383353                   
    384 !!! VERS 2: use R specific = R/MolarMass
    385 
    386            dens=pplay(ig,l)/(rnew(ig,l)*zt(ig,l)) / 1.66e-21   ! [g mol-1] [cm-3]         
    387 
    388           rm(l,i_co2)  = co2vmr_gcm(ig,l) * dens / mmolco2     ! [cm-3]
    389           rm(l,i_o)    =  o3pvmr_gcm(ig,l) *dens / mmolo
    390           rm(l,i_co)   = covmr_gcm(ig,l) * dens  / mmolco
    391           rm(l,i_n2)   = n2vmr_gcm(ig,l) * dens  / mmoln2
    392           rm(l,i_n)    = nvmr_gcm(ig,l)  * dens  / mmoln
    393 
    394 !          if(ig .eq. 1 .and. l .eq. 50) then
    395 !            print*,'---EUV ---'
    396 !            print*,i_co2, 'rm:',  rm(l,i_co2), 'covmr:',co2vmr_gcm(ig,l), pplay(ig,l), zt(ig,l)
    397 !             print*,'dens:', pplay(ig,l)/(RKBOL*zt(ig,l)*1.e6)
    398 !            print*, 'rnew:',  rnew(ig,l)   !, 'dens2:',  pplay(ig,l)/(rnew(ig,l)*zt(ig,l))/ 1.66e-21   
    399 !           endif           
     354!!!  use R specific = R/MolarMass
     355
     356            dens=pplay(ig,l)/(rnew(ig,l)*zt(ig,l)) / 1.66e-21   ! [g mol-1] [cm-3]         
     357
     358            rm(l,ix_co2)  = zq(ig,l,g_co2) * dens / M_tr(g_co2)   ! [cm-3]
     359            rm(l,ix_o)    = zq(ig,l,g_o)   * dens / M_tr(g_o)
     360            rm(l,ix_co)   = zq(ig,l,g_co) * dens  / M_tr(g_co)
     361            rm(l,ix_n2)   = zq(ig,l,g_n2) * dens  / M_tr(g_n2)
     362
     363!           write(*,*),  "CHECK n density", l, rm(l,ix_co2)
     364
    400365
    401366         enddo
    … …  
    415380         call hrtherm (ig,euvmod,rm,nespeuv,tx,zlocal,zenit,zday,jtot)
    416381         
    417 !    value for the UV heating efficiency
    418 !    (experimental values between 0.19 and 0.23, lower values may
    419 !    be used to compensate for low 15 um cooling)
    420 ! read in physiq.def
    421 ! default value:  euveff=0.21   !Fox1988 
    422382
    423383        !Calculates the UV heating from the total photoabsorption coefficient
    … …  
    427387               /(cpnew(ig,l)*pplay(ig,l)/(rnew(ig,l)*zt(ig,l)))
    428388
    429 
    430 !               !The solar flux calculated in
    431                 !flujo.F is already corrected for
    432                 !the actual Venus-Sun distance
    433 
    434 !        print*, 'EUV heat'                                           
    435 !        print*, ig, l, pdteuv(ig,l), euveff, jtot(l), cpnew(ig, l), rnew(ig,l)
    436 !         stop
    437 
    438389        enddo   
    439390      enddo  ! of do ig=1,nlon
     391
    440392      !Deallocations
    441       deallocate(rm)
     393      !deallocate(rm)
    442394
    443395      return

  • trunk/LMDZ.VENUS/libf/phyvenus/hrtherm.F

    r1310 r1442  
    7979         xabsi(3,i)  = rm(i,i_o)
    8080         xabsi(8,i)  = rm(i,i_n2)
    81          xabsi(9,i)  = rm(i,i_n)
    8281         xabsi(11,i)  = rm(i,i_co)
    8382
    … …  
    116115            jtot(i)=jtot(i)+jergs(indexint,j,i)   
    117116 
    118 c            if (j .eq. 1 .and. i .eq. 60) then
    119 c              print*, '-- hrtherm 2---'
    120 c              print*, indexint, j,i, xabsi(j,i), jfotsout(indexint,j,i),
    121 c     $             fluxtop(indexint), freccen(indexint)
    122 c            end if
     117
    123118          end do
    124119        end do

  • trunk/LMDZ.VENUS/libf/phyvenus/ini_histins.h

    r1305 r1442  
    102102c
    103103c plusieurs traceurs
    104          if (iflag_trac.eq.1) THEN
     104          if (ok_chem) THEN
    105105            DO iq=1,nqmax
     106c            DO iq=1,10
    106107             IF (iq.LE.99) THEN
    107108          WRITE(str2,'(i2.2)') iq
    108           CALL histdef(nid_ins, tname(iq), ttext(iq), "vmr",
     109          CALL histdef(nid_ins, tname(iq), ttext(iq), "mol/mol",
    109110     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    110111     .                "ins(X)", zsto,zout)
    … …  
    114115             ENDIF
    115116            ENDDO
    116          endif
     117          CALL histdef(nid_mth, "d_qmoldif CO2", "Dif molec" , "kg/kg",
     118     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
     119     .                "ave(X)", zsto,zout)
     120          CALL histdef(nid_mth, "d_qmoldif O3p", "Dif molec" , "kg/kg",
     121     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
     122     .                "ave(X)", zsto,zout)
     123          CALL histdef(nid_mth, "d_qmoldif N2", "Dif molec" , "kg/kg",
     124     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
     125     .                "ave(X)", zsto,zout)
     126
     127          endif
    117128c
    118129         CALL histdef(nid_ins, "tops", "Solar rad. at TOA", "W/m2",
    … …  
    120131     .                "ins(X)", zsto,zout)
    121132c
    122          if (ok_cloud) THEN
    123           CALL histdef(nid_ins, "NBRTOT", "Nbr total droplet", "#/cm3",
    124      .                iim,jj_nb,nhori, klev,1,klev, nvert, 32,
    125      .                "ins(X)", zsto,zout)
    126           CALL histdef(nid_ins, "WH2SO4", "Weight fraction H2SO4",
    127      .     "fraction",iim,jj_nb,nhori, klev,1,klev, nvert, 32,
    128      .                "ins(X)", zsto,zout)
    129           CALL histdef(nid_ins, "R_MEDIAN",
    130      .     "Median radius fo log normal distribution" ,
    131      .     "fraction",iim,jj_nb,nhori, klev,1,klev, nvert, 32,
    132      .                "ins(X)", zsto,zout)
    133           CALL histdef(nid_ins, "STDDEV",
    134      .     "Std Deviation for lor normaldistribution",
    135      .     "fraction",iim,jj_nb,nhori, klev,1,klev, nvert, 32,
    136      .                "ins(X)", zsto,zout)
    137           CALL histdef(nid_ins, "rho_droplet", "density cloud droplet",
    138      .       "kg.m-3",iim,jj_nb,nhori, klev,1,klev, nvert, 32,
    139      .                "ins(X)", zsto,zout)
    140          endif
    141 
    142          if (ok_sedim) THEN
    143           CALL histdef(nid_ins,"d_tr_sed_H2SO4","H2SO4 mmr from sedim",
    144      .        "kg/kg",iim,jj_nb,nhori, klev,1,klev, nvert, 32,
    145      .                "ins(X)", zsto,zout)
    146           CALL histdef(nid_ins,"d_tr_sed_H2O", "H2O mmr from sedim",
    147      .        "kg/kg",iim,jj_nb,nhori, klev,1,klev, nvert, 32,
    148      .                "ins(X)", zsto,zout)
    149           CALL histdef(nid_ins, "F_sedim", "tendency from sedim",
    150      .   "kg.m-2.s-1",iim,jj_nb,nhori, klev,1,klev, nvert, 32,
    151      .                "ins(X)", zsto,zout)
    152          endif
    153 
     133          if (ok_cloud) THEN
     134
     135          if (nb_mode.GE.1) THEN
     136           
     137c
     138         CALL histdef(nid_ins, "NBRTOTm1", "Nbr total droplet",
     139     .                "#/cm3", iim,jj_nb,nhori, klev,1,klev, nvert, 32,
     140     .                "ins(X)", zsto,zout)
     141c
     142
     143c
     144c         CALL histdef(nid_ins, "R_MEDIANm1", "Median radius
     145c     .    for log normal distribution" ,
     146c     .                "fraction",
     147c     .                iim,jj_nb,nhori, klev,1,klev, nvert, 32,
     148c     .                "ins(X)", zsto,zout)
     149c
     150
     151c
     152c         CALL histdef(nid_ins, "STDDEVm1", "Std Deviation
     153c     .    for log normal distribution",
     154c     .                "fraction",
     155c     .                iim,jj_nb,nhori, klev,1,klev, nvert, 32,
     156c     .                "ins(X)", zsto,zout)
     157c
     158
     159          if (nb_mode.GE.2) THEN
     160
     161c
     162         CALL histdef(nid_ins, "NBRTOTm2", "Nbr total droplet",
     163     .                "#/cm3", iim,jj_nb,nhori, klev,1,klev, nvert, 32,
     164     .                "ins(X)", zsto,zout)
     165c
     166
     167c
     168c         CALL histdef(nid_ins, "R_MEDIANm2", "Median radius
     169c     .    for log normal distribution" ,
     170c     .                "fraction",
     171c     .                iim,jj_nb,nhori, klev,1,klev, nvert, 32,
     172c     .                "ins(X)", zsto,zout)
     173c
     174
     175c
     176c         CALL histdef(nid_ins, "STDDEVm2", "Std Deviation
     177c     .    for log normal distribution",
     178c     .                "fraction",
     179c     .                iim,jj_nb,nhori, klev,1,klev, nvert, 32,
     180c     .                "ins(X)", zsto,zout)
     181c
     182
     183          if (nb_mode.GE.3) THEN
     184         
     185c
     186         CALL histdef(nid_ins, "NBRTOTm3", "Nbr total droplet", "#/cm3",
     187     .                iim,jj_nb,nhori, klev,1,klev, nvert, 32,
     188     .                "ins(X)", zsto,zout)
     189c
     190
     191c
     192c         CALL histdef(nid_ins, "R_MEDIANm3", "Median radius
     193c     .   for log normal distribution" ,
     194c     .                "fraction",
     195c     .                iim,jj_nb,nhori, klev,1,klev, nvert, 32,
     196c     .                "ins(X)", zsto,zout)
     197c
     198
     199c
     200c         CALL histdef(nid_ins, "STDDEVm3", "Std Deviation
     201c     .    for log normal distribution",
     202c     .                "fraction",
     203c     .                iim,jj_nb,nhori, klev,1,klev, nvert, 32,
     204c     .                "ins(X)", zsto,zout)
     205c
     206
     207         ENDIF
     208         ENDIF
     209         ENDIF
     210         
     211c
     212         CALL histdef(nid_ins, "WH2SO4", "Weight fraction H2SO4",
     213     .                "fraction",
     214     .                iim,jj_nb,nhori, klev,1,klev, nvert, 32,
     215     .                "ins(X)", zsto,zout)
     216c
     217
     218c
     219         CALL histdef(nid_ins, "rho_droplet", "density cloud droplet",
     220     .                "kg.m-3",
     221     .                iim,jj_nb,nhori, klev,1,klev, nvert, 32,
     222     .                "ins(X)", zsto,zout)
     223c
     224
     225                ENDIF
     226               
     227          if (ok_sedim) THEN
     228c
     229         CALL histdef(nid_ins, "d_tr_sed_H2SO4", "var mmr from sedim",
     230     .                "kg/kg",
     231     .                iim,jj_nb,nhori, klev,1,klev, nvert, 32,
     232     .                "ins(X)", zsto,zout)
     233c
     234
     235c
     236         CALL histdef(nid_ins, "d_tr_sed_H2O", "var mmr from sedim",
     237     .                "kg/kg",
     238     .                iim,jj_nb,nhori, klev,1,klev, nvert, 32,
     239     .                "ins(X)", zsto,zout)
     240c
     241
     242c
     243         CALL histdef(nid_ins, "F_sedim", "tendency from sedim",
     244     .                "kg.m-2.s-1",
     245     .                iim,jj_nb,nhori, klev,1,klev, nvert, 32,
     246     .                "ins(X)", zsto,zout)
     247c
     248                ENDIF
    154249      ENDIF !lev_histins.GE.2
    155250c

  • trunk/LMDZ.VENUS/libf/phyvenus/jthermcalc.F

    r1310 r1442  
    1414      use dimphy
    1515      use conc
     16c      use chemparam_mod
    1617      implicit none
    1718
    1819c     common variables and constants
    19 #include "dimensions.h"
    20 #include "param.h"
    21 #include "param_v4.h"
     20      include "dimensions.h"
     21      include "param.h"
     22      include "param_v4.h"
    2223
    2324c     input and output variables
    … …  
    3738      real       o3pcolx(klev)              !column density of O(3P)(cm^-2)
    3839      real       n2colx(klev)               !N2 column density (cm-2)
    39       real       ncolx(klev)                !N column density (cm-2)
    4040      real       cocolx(klev)               !CO column density (cm-2)
    4141c      real       o2colx(klev)               !column density of O2(cm^-2)
    … …  
    6868c     real*8      auxjo3(nz2)
    6969      real*8      auxjn2(nz2)
    70       real*8      auxjn(nz2)
     70c      real*8      auxjn(nz2)
    7171c     real*8      auxjno(nz2)
    7272      real*8      auxjco(nz2)
    … …  
    8484
    8585 
    86       ! Tracer indexes in the thermospheric chemistry:
    87       !!! ATTENTION. These values have to be identical to those in euvheat.F90
    88       !!! If the values are changed there, the same has to be done here  !!!
    89 
    90       integer,parameter :: i_co2=1
    91       integer,parameter :: i_n2=13
    92       integer,parameter :: i_n=14
    93       integer,parameter :: i_o=3
    94       integer,parameter :: i_co=4
     86! Tracer indexes in the thermospheric chemistry:
     87!!! ATTENTION. These values have to be identical to those in euvheat.F90
     88!!! If the values are changed there, the same has to be done here  !!!
     89
     90      integer,parameter :: ix_co2=1
     91      integer,parameter :: ix_n2=13
     92c      integer,parameter :: i_n=14
     93      integer,parameter :: ix_o=3
     94      integer,parameter :: ix_co=4
    9595
    9696
    … …  
    118118
    119119      !Calculation of column amounts
    120 c     call column(ig,chemthermod,rm,nesptherm,tx,iz,zenit,
    121 c    $     co2colx,o2colx,o3pcolx,h2colx,h2ocolx,
    122 c    $     h2o2colx,o3colx,n2colx,ncolx,nocolx,cocolx,hcolx,no2colx)
    123120      call column(ig,chemthermod,rm,nesptherm,tx,iz,zenit,
    124      $     co2colx,o3pcolx, n2colx,ncolx,cocolx)
     121     $     co2colx,o3pcolx, n2colx,cocolx)
    125122
    126123      !Auxiliar column to include the temperature dependence
    … …  
    129126      do i=klev-1,1,-1
    130127        coltemp(i)=!coltemp(i+1)+     PQ SE ELIMINA? REVISAR
    131      $         ( rm(i,i_co2) + rm(i+1,i_co2) ) * 0.5
     128     $         ( rm(i,ix_co2) + rm(i+1,ix_co2) ) * 0.5
    132129     $         * 1e5 * (iz(i+1)-iz(i)) * abs(t2(i)-t0(i))
    133130      end do
    … …  
    162159         auxcolinp(klev-i+1) = co2colx(i)*crscabsi2(1,indexint) +
    163160c     $        o2colx(i)*crscabsi2(2,indexint) +
    164      $        o3pcolx(i)*crscabsi2(3,indexint) +
     161     $        o3pcolx(i)*crscabsi2(3,indexint)
    165162c     $        h2colx(i)*crscabsi2(5,indexint) +
    166      $        ncolx(i)*crscabsi2(9,indexint)
    167163      end do
    168164      limdown=1.e-20
    … …  
    183179c         auxjh2(i) = jabsifotsintpar(auxi,5,indexint)
    184180         !N tabulated coefficient
    185          auxjn(i) = jabsifotsintpar(auxi,9,indexint)
     181c         auxjn(i) = jabsifotsintpar(auxi,9,indexint)
    186182         !Tabulated column
    187183         auxcoltab(i) = c1_16(auxi,indexint)
    … …  
    214210c     $         wp(i)*auxjh2(ind)
    215211c      !N interpolated coefficient
    216             jfotsout(indexint,9,auxi) =  wm(i)*auxjn(ind+1) +
    217      $         wp(i)*auxjn(ind)
    218 
    219 c      print*, '--- 1 jthermcal.F ---'
    220 c      print*, jfotsout(indexint,1,auxi)
     212c            jfotsout(indexint,9,auxi) =  wm(i)*auxjn(ind+1) +
     213c     $         wp(i)*auxjn(ind)
     214
     215C      print*, '--- L214 jthermcal.F ---'
     216C      print*, jfotsout(indexint,1,auxi)
    221217c      STOP         
    222 
    223218
    224219      enddo
    … …  
    252247     $           o3pcolx(i)*crscabsi2(3,indexint)+
    253248     $           n2colx(i)*crscabsi2(8,indexint)+
    254      $           ncolx(i)*crscabsi2(9,indexint)+
    255249     $           cocolx(i)*crscabsi2(11,indexint)
    256250
    … …  
    277271            auxjn2(i) = jabsifotsintpar(auxi,8,indexint)
    278272            !N tabulated coefficient
    279             auxjn(i) = jabsifotsintpar(auxi,9,indexint)
     273c            auxjn(i) = jabsifotsintpar(auxi,9,indexint)
    280274            !CO tabulated coefficient
    281275            auxjco(i) = jabsifotsintpar(auxi,11,indexint)
    … …  
    319313     $            wp(i)*auxjn2(ind)             
    320314             !N interpolated coefficient
    321              jfotsout(indexint,9,auxi) = wm(i)*auxjn(ind+1) +
    322      $            wp(i)*auxjn(ind)
     315c             jfotsout(indexint,9,auxi) = wm(i)*auxjn(ind+1) +
     316c     $            wp(i)*auxjn(ind)
    323317             !CO interpolated coefficient
    324318             jfotsout(indexint,11,auxi) = wm(i)*auxjco(ind+1) +
    … …  
    364358     $        o3pcolx(i)*crscabsi2(3,indexint)+
    365359     $        n2colx(i)*crscabsi2(8,indexint)+
    366      $        ncolx(i)*crscabsi2(9,indexint)+
    367 c     $        nocolx(i)*crscabsi2(10,indexint)+
    368360     $        cocolx(i)*crscabsi2(11,indexint)
    369361c     $        hcolx(i)*crscabsi2(12,indexint)+
    … …  
    386378         auxjco(i) = jabsifotsintpar(auxi,11,indexint)
    387379c        !N tabulated coefficient
    388          auxjn(i) = jabsifotsintpar(auxi,9,indexint)
     380c         auxjn(i) = jabsifotsintpar(auxi,9,indexint)
    389381
    390382         !NO tabulated coefficient
    … …  
    432424     $            wp(i)*auxjco(ind) 
    433425         !N interpolated coefficient
    434           jfotsout(indexint,9,auxi) = wm(i)*auxjn(ind+1) +
    435      $           wp(i)*auxjn(ind)
     426c          jfotsout(indexint,9,auxi) = wm(i)*auxjn(ind+1) +
     427c     $           wp(i)*auxjn(ind)
    436428
    437429c         !H interpolated coefficient
    … …  
    10571049c**********************************************************************
    10581050
    1059 c      subroutine column(ig,chemthermod,rm,nesptherm,tx,iz,zenit,
    1060 c     $     co2colx,o2colx,o3pcolx,h2colx,h2ocolx,h2o2colx,o3colx,
    1061 c     $     n2colx,ncolx,nocolx,cocolx,hcolx,no2colx)
    10621051      subroutine column(ig,chemthermod,rm,nesptherm,tx,iz,zenit,
    1063      $     co2colx,o3pcolx, n2colx,ncolx,cocolx)
     1052     $     co2colx,o3pcolx, n2colx, cocolx)
    10641053
    10651054c     mar 2014        gg            adapted to Venus GCM
    … …  
    10871076      integer    ig
    10881077      integer    chemthermod
    1089       integer    nesptherm                      !# of species undergoing chemistry, input
     1078      integer    nesptherm                   !# of species undergoing chemistry, input
    10901079      real       rm(klev,nesptherm)         !densities (cm-3), input
    10911080      real       tx(klev)                   !temperature profile, input
    … …  
    10951084      real       o3pcolx(klev)              !column density of O(3P)(cm^-2), output
    10961085      real       n2colx(klev)               !N2 column density (cm-2), output
    1097       real       ncolx(klev)                !N column density (cm-2), output
    10981086      real       cocolx(klev)               !CO column density (cm-2), output
    10991087
    … …  
    11491137      real*8      szadeg
    11501138
    1151       ! Tracer indexes in the thermospheric chemistry:
    1152       !!! ATTENTION. These values have to be identical to those in euvheat.F90
    1153       !!! If the values are changed there, the same has to be done here  !!!
    1154 
    1155       integer,parameter :: i_co2=1
    1156       integer,parameter :: i_n2=13
    1157       integer,parameter :: i_n=14
    1158       integer,parameter :: i_o=3
    1159       integer,parameter :: i_co=4
     1139! Tracer indexes in the thermospheric chemistry:
     1140!!! ATTENTION. These values have to be identical to those in euvheat.F90
     1141!!! If the values are changed there, the same has to be done here  !!!
     1142
     1143      integer,parameter :: ix_co2=1
     1144      integer,parameter :: ix_n2=13
     1145      integer,parameter :: ix_o=3
     1146      integer,parameter :: ix_co=4
    11601147
    11611148c*************************PROGRAM STARTS*******************************
    … …  
    11931180         o3pcolx(i)  = 0.
    11941181         n2colx(i)   = 0.
    1195          ncolx(i)    = 0.
    11961182         cocolx(i)   = 0.
    11971183
    11981184         !--Densities [cm-3]
    1199          co2x(i)  = rm(i,i_co2)
    1200          o3px(i)  = rm(i,i_o)
    1201          cox(i)   = rm(i,i_co)
    1202          n2x(i)   = rm(i,i_n2)
    1203          nx(i)    = rm(i,i_n)
     1185         co2x(i)  = rm(i,ix_co2)
     1186         o3px(i)  = rm(i,ix_o)
     1187         cox(i)   = rm(i,ix_co)
     1188         n2x(i)   = rm(i,ix_n2)
     1189
     1190c         write(*,*), '--jthermcalc--', co2x(i)
    12041191
    12051192         !Only if O3 chem. required
    … …  
    12231210            o3pcolx(i)=1.e25
    12241211            n2colx(i)=1.e25
    1225             ncolx(i)=1.e25
    12261212            cocolx(i)=1.e25
    12271213
    … …  
    12321218c            h2o2colx(i)=1.e25
    12331219c            o3colx(i)=1.e25
    1234 c            n2colx(i)=1.e25
    12351220c            ncolx(i)=1.e25
    12361221c            nocolx(i)=1.e25
    … …  
    12561241                     n2colx(i)=n2colx(i)+n2x(klev)*Hn2*esp(j)
    12571242     $                    *1.e-5
    1258                      ncolx(i)=ncolx(i)+nx(klev)*Hn*esp(j)
    1259      $                       *1.e-5
    12601243
    12611244c                     h2o2colx(i)=h2o2colx(i)+
    … …  
    12791262c                        n2colx(i)=n2colx(i)+n2x(klev)*Hn2*esp(j)
    12801263c     $                    *1.e-5
    1281 c                        ncolx(i)=ncolx(i)+nx(klev)*Hn*esp(j)
    1282 c     $                       *1.e-5
    1283 c                        nocolx(i)=nocolx(i)+nox(klev)*Hno*esp(j)
    1284 c     $                       *1.e-5
    1285 c                        no2colx(i)=no2colx(i)+no2x(klev)*Hno2*esp(j)
    1286 c     $                       *1.e-5
     1264
    12871265c                     endif
    12881266                  else if(zenit.gt.60.) then
    … …  
    13131291                     cocolx(i)  = cocolx(i)  + espco*cox(klev)
    13141292                     n2colx(i)  = n2colx(i)  + espn2*n2x(klev)
    1315                      ncolx(i)   = ncolx(i)   + espn*nx(klev)
    13161293
    13171294c                     o2colx(i)  = o2colx(i)  + espo2*o2x(klev)
    … …  
    13421319                  n2colx(i)   = n2colx(i) +
    13431320     $                 esp(j) * (n2x(jj)+n2x(jj+1)) / 2.
    1344                   ncolx(i)    = ncolx(i) +
    1345      $                    esp(j) * (nx(jj)+nx(jj+1)) / 2.
     1321
    13461322c
    13471323c                  o2colx(i)   = o2colx(i) +
    … …  
    17341710
    17351711       real date
    1736       integer, parameter :: dateyr = 2006
     1712c       integer, parameter :: dateyr = 2006
    17371713
    17381714!     Local variable and constants
    1739       real, parameter :: dist_sol=0.72
     1715!    dist_sol : distance venus - soleil
     1716
     1717      real, parameter :: dist_sol=0.72333
    17401718      integer i
    17411719      integer inter
    … …  
    17441722!c*************************************************
    17451723
    1746       if(dateyr.lt.1985.) date=1985.
    1747       if(dateyr.gt.2001.) date=2001.
     1724      if(date.lt.1985.) date=1985.
     1725      if(date.gt.2001.) date=2001.
    17481726     
    17491727      do i=1,ninter
    … …  
    17611739 !      is  corrected for
    17621740 !     the actual Venus-Sun dist
    1763         fluxtop(i)=fluxtop(i)*(1/dist_sol)**2
    1764 
    1765       !TEST
    1766 c        fluxtop(i) = fluxtop(i)*10
     1741        fluxtop(i)=fluxtop(i)*(1./dist_sol)**2
     1742
    17671743
    17681744       end do

  • trunk/LMDZ.VENUS/libf/phyvenus/new_cloud_sedim.F

    r1305 r1442  
    11      SUBROUTINE new_cloud_sedim(n_lon,n_lev,ptimestep,
    22     &                pmidlay,pbndlay,
    3      &                pt,wgt_h2so4,pq,nq,Np,rho_p,
    4      &                F_sed,pdqsed,pdqs_sed)
     3     &                pt,
     4     &                pq, pdqsed,pdqs_sed,nq,F_sed)
    55
    66      USE ioipsl
    … …  
    3636      REAL pt(n_lon,n_lev)          ! temperature at mid-layer (l)
    3737      REAL pbndlay(n_lon,n_lev+1)   ! pressure at layer boundaries
    38 c    Aerosol radius provided by the water ice microphysical scheme:
    39 c    rdroplet non utilise ???
    40 c      REAL rdroplet(n_lon,n_lev)   ! Dust geometric mean radius (m)
    41 c      REAL rice(n_lon,n_lev)           ! Ice geometric mean radius (m)
    42       REAL wgt_h2so4(n_lon,n_lev)   ! Fraction of H2SO4 in droplet
    4338
    4439c    Traceurs :
    … …  
    5146c   local:
    5247c   ------
    53 
     48      integer imode
    5449      integer ig
    5550      integer iq
    … …  
    6055      real zqi_wv(n_lon,n_lev)      ! to locally store H2O tracer
    6156      real zqi_sa(n_lon,n_lev)      ! to locally store H2SO4 tracer
    62       real m_lay (n_lon,n_lev)      ! Layer Pressure over gavity (Dp/g == kg.m-2)
     57      real m_lay (n_lon,n_lev)      ! Layer Pressure over gravity (Dp/g == kg.m-2)
    6358      real wq(n_lon,n_lev+1)        ! displaced tracer mass (kg.m-2)
    6459
    … …  
    6661c    ~~~~~~~~~~~~~~~~~
    6762c     Gas molecular viscosity (N.s.m-2)
    68       real,parameter :: visc=1.e-5       ! CO2
     63c      real,parameter :: visc=1.e-5       ! CO2
     64        REAL :: VISCOSITY_CO2
    6965c     Effective gas molecular radius (m)
    7066      real,parameter :: molrad=2.2e-10   ! CO2
    … …  
    7268c     Cloud density (kg.m-3)
    7369c     ~~~~~~~~~~~~~~~~~~~~~~
    74       real, DIMENSION(n_lon,n_lev) ::  rho_p
     70c      real, DIMENSION(n_lon,n_lev) ::  rho_droplet
    7571
    7672      REAL, DIMENSION(n_lon,n_lev+1) ::
    … …  
    8581     + l_mean,                        ! libre parcours moyen (m)
    8682     + a,b_exp,c                      ! coeff du calcul du Flux de sedimentation
    87       REAL, DIMENSION(n_lon,n_lev) ::
    88      + Np                             ! Nombre de particules (#.cm-3)
    8983      REAL, DIMENSION(n_lon,n_lev+1) ::
    9084     + F_sed                          ! Flux de sedimentation (kg.m-2.s-1 puis en output kg.m-2)
    … …  
    9488
    9589
     90
     91!      PRINT*,'RHO_DROPLET new_cloud_sedim.F'
     92!      PRINT*,'rho_droplet',rho_droplet(16,21)
     93!      PRINT*,'T',pt(16,21),'WSA',WH2SO4(16,21)
    9694
    9795c-----------------------------------------------------------------------
    … …  
    106104         zqi_wv(ig,l) = pq(ig,l,i_h2oliq)
    107105         zqi_sa(ig,l) = pq(ig,l,i_h2so4liq)
    108          wgt_SA(ig,l) = wgt_h2so4(ig,l)
     106         wgt_SA(ig,l) = WH2SO4(ig,l)
    109107         enddo
    110108      enddo
    111      
    112       wgt_SA(:,n_lev+1) = 0.0D0
    113       F_sed(:,n_lev+1) = 0.0D0
     109
     110c     Init F_sed
     111      F_sed(:,:) = 0.0E+0
     112
     113c     Au niveau top+1 , tout égal a 0     
     114      wgt_SA(:,n_lev+1) = 0.0E+0   
    114115
    115116c    Computing the different layer properties
    116117c    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    117 c    m_lay (kg.m-2), thickness(m), crossing time (s)  etc.
     118c    m_lay (kg.m-2)
    118119c    Ici g=8.87, conflit pour g entre #include "YOMCST.h"
    119120c       et #include "comcstfi.h"
    … …  
    121122      do  l=1,n_lev
    122123         do ig=1, n_lon
    123          m_lay(ig,l)=(pbndlay(ig,l) - pbndlay(ig,l+1)) /8.87d0
     124         m_lay(ig,l)=(pbndlay(ig,l) - pbndlay(ig,l+1)) /8.87E+0
    124125            IF (m_lay(ig,l).LE.0.0) THEN
    125126            PRINT*,'!!!! STOP PROBLEME SEDIMENTATION!!!!'
    … …  
    134135c           pbndlay(:,51)=0 (en parallèle c'est sûr), ne pas l'utiliser pour Fse
    135136       
    136       DO l = 1, n_lev
    137          DO ig=1,n_lon
    138 
    139 c   On calcule un Flux de sedimentation uniquement pour les couche avec une partie
    140 c   significative de droplet
    141 
    142            IF ((Np(ig,l).GT.1.0e-20)) THEN
     137        DO imode=1, nbr_mode
     138         DO l = cloudmin, cloudmax
     139            DO ig=1,n_lon
    143140
    144141c     RD=1000.*RNAVO*RKBOL/RMD avec RMD=43.44 Masse molaire atm venus en g.mol-1     
    145            D_stokes=(rho_p(ig,l)-pmidlay(ig,l)/(RD*pt(ig,l)))
    146      &  *2./9.*RG/visc
     142           D_stokes=((rho_droplet(ig,l)-pmidlay(ig,l)/(RD*pt(ig,l))))
     143     &  *(2./9.)*(RG/VISCOSITY_CO2(pt(ig,l)))
    147144     
    148145           l_mean=(pt(ig,l)/pmidlay(ig,l))*
    149146     &  (0.707*R/(4.*RPI* molrad*molrad * RNAVO))
    150147     
    151            R_mode0=R_MEDIAN(ig,l)*EXP(-LOG(STDDEV(ig,l))**2.)
    152               IF ((l_mean/(R_mode0)).LT.1.) THEN
    153               Rp_DL=R_MEDIAN(ig,l)*EXP(3.*LOG(STDDEV(ig,l))**2.)
     148           R_mode0=R_MEDIAN(ig,l,imode)*
     149     &     EXP(-LOG(STDDEV(ig,l,imode))**2.)
     150              IF ((l_mean/(R_mode0)).GT.10.) THEN
     151              Rp_DL=R_MEDIAN(ig,l,imode)*
     152     &        EXP(3.*LOG(STDDEV(ig,l,imode))**2.)
    154153              ELSE
    155               Rp_DL=R_MEDIAN(ig,l)*EXP(4.*LOG(STDDEV(ig,l))**2.)
     154              Rp_DL=R_MEDIAN(ig,l,imode)*
     155     &        EXP(4.*LOG(STDDEV(ig,l,imode))**2.)
    156156              ENDIF
    157157               
    … …  
    168168           A2=1.-b_exp*(c
    169169     &  +Rp_DL*c**2
    170      &  +0.5*Rp_DL**2*c**3)
     170     &  +0.5*(Rp_DL**2)*(c**3))
    171171       
    172172           A3=0.5*b_exp*(c**2+Rp_DL*c**3)
    173173       
    174174           A4=-b_exp*1./6.*c**3
    175        
    176            F_sed(ig,l)=rho_p(ig,l)*4./3.*RPI*
    177      &  Np(ig,l)*1.0e6*D_stokes*(
    178      &  A1*R_MEDIAN(ig,l)**4*EXP(8.0*LOG(STDDEV(ig,l))**2.)
    179      &  +A2*R_MEDIAN(ig,l)**5*EXP(12.5*LOG(STDDEV(ig,l))**2.)
    180      &  +A3*R_MEDIAN(ig,l)**6*EXP(18.0*LOG(STDDEV(ig,l))**2.)
    181      &  +A4*R_MEDIAN(ig,l)**7*EXP(24.5*LOG(STDDEV(ig,l))**2.))
    182      
    183 c      PRINT*,' AVANT dTime: F_sed=',F_sed(ig,l), ig, l
    184      
    185            F_sed(ig,l)=F_sed(ig,l)*ptimestep
     175
     176c     Addition des Flux de tous les modes presents     
     177       F_sed(ig,l)=F_sed(ig,l)+(rho_droplet(ig,l)*4./3.*RPI*
     178     &  NBRTOT(ig,l,imode)*1.0E6*D_stokes*(
     179     &  A1*R_MEDIAN(ig,l,imode)**4
     180     &  *EXP(8.0*LOG(STDDEV(ig,l,imode))**2.)
     181     &  +A2*R_MEDIAN(ig,l,imode)**5
     182     &  *EXP(12.5*LOG(STDDEV(ig,l,imode))**2.)
     183     &  +A3*R_MEDIAN(ig,l,imode)**6
     184     &  *EXP(18.0*LOG(STDDEV(ig,l,imode))**2.)
     185     &  +A4*R_MEDIAN(ig,l,imode)**7
     186     &  *EXP(24.5*LOG(STDDEV(ig,l,imode))**2.)))
    186187     
    187188c      PRINT*,' APRES dTime: F_sed=',F_sed(ig,l), ig, l
    188189     
    189 c       IF (F_sed(ig,l).GT.m_lay(ig,l)) THEN
    190 c       PRINT*,'==============================================='
    191 c       PRINT*,'WARNING On a epuise la couche', ig, l
    192 c       PRINT*,'F_sed:',F_sed(ig,l),'m_lay:',m_lay(ig,l)
    193 c       PRINT*,'F_sed/dtphy',F_sed(ig,l)/ptimestep
    194 c       PRINT*,'Pbnd top',pbndlay(ig,l+1),'Temp',pt(ig,l),'Rho',
    195 c     &         rho_p(ig,l)
    196 c               PRINT*,'Ntot',Np(ig,l),'Ntot m3',Np(ig,l)*1.0e6
    197 c               PRINT*,'StdDev',STDDEV(ig,l),'Rmed',R_MEDIAN(ig,l)
     190        IF (F_sed(ig,l).GT.m_lay(ig,l)) THEN
     191        PRINT*,'==============================================='
     192        PRINT*,'WARNING On a epuise la couche', ig, l
     193        PRINT*,'On epuise pas une couche avec une espèce
     194     &   minoritaire, c est pas bien maaaaaal'
     195            PRINT*,'Water',zqi_wv(ig,l),'Sulfuric Acid',zqi_sa(ig,l)
     196        PRINT*,'F_sed:',F_sed(ig,l),'m_lay:',m_lay(ig,l)
     197        PRINT*,'F_sed/dtphy',F_sed(ig,l)/ptimestep
     198        PRINT*,'Pbnd top',pbndlay(ig,l+1),'Temp',pt(ig,l),'Rho',
     199     &  rho_droplet(ig,l)
     200                PRINT*,'Ntot',NBRTOT(ig,l,:)
     201                PRINT*,'StdDev',STDDEV(ig,l,:),'Rmed',R_MEDIAN(ig,l,:)
     202                PRINT*,'K_MASS',K_MASS(ig,l,:)
     203                PRINT*,'WSA',WH2SO4(ig,l),'RHO',rho_droplet(ig,l)
    198204               
    199205c               ELSE
    … …  
    204210c       PRINT*,'F_sed/dtphy',F_sed(ig,l)/ptimestep
    205211c       PRINT*,'Pbnd top',pbndlay(ig,l+1),'Temp',pt(ig,l),'Rho',
    206 c     &         rho_p(ig,l)(ig,l)
    207 c               PRINT*,'Ntot',Np(ig,l),'Ntot m3',Np(ig,l)*1.0e6
    208 c               PRINT*,'StdDev',STDDEV(ig,l),'Rmed',R_MEDIAN(ig,l)             
    209 c       ENDIF
    210      
    211            ELSE
    212            F_sed(ig,l)=0.0d0
    213            ENDIF
    214        
    215            IF (F_sed(ig,l).LT.0.0e0) THEN
     212c     &         rho_droplet(ig,l)(ig,l)
     213c               PRINT*,'Ntot',NBRTOT(ig,l),'Ntot m3',NBRTOT(ig,l)*1.0e6
     214c               PRINT*,'StdDev',STDDEV(ig,l),'Rmed',R_MEDIAN(ig,l)
     215            STOP               
     216              ENDIF
     217       
     218           IF (F_sed(ig,l).LT.0.0d0) THEN
    216219              PRINT*,"F_sed est négatif !!!"
    217220              PRINT*,'F_sed:',F_sed(ig,l),'m_lay:',m_lay(ig,l)
    … …  
    219222        PRINT*,'Pbnd top',pbndlay(ig,l+1),'Pmid',pmidlay(ig,l)
    220223        PRINT*,'Temp',pt(ig,l),'Rho',
    221      &  rho_p(ig,l)
    222                 PRINT*,'Ntot',Np(ig,l),'Ntot m3',Np(ig,l)*1.0e6
    223                 PRINT*,'StdDev',STDDEV(ig,l),'Rmed',R_MEDIAN(ig,l)
     224     &  rho_droplet(ig,l)
     225                PRINT*,'Ntot',NBRTOT(ig,l,imode),'Ntot m3',
     226     &  NBRTOT(ig,l,imode)*1.0e6
     227                PRINT*,'StdDev',STDDEV(ig,l,imode),'Rmed',
     228     &          R_MEDIAN(ig,l,imode)
    224229                PRINT*,'A1',A1,'A2',A2
    225230                PRINT*,'A3',A1,'A4',A2
    … …  
    227232                STOP
    228233           ENDIF
    229        
     234           
     235              ENDDO
     236             
     237c           ELSE           
     238c           F_sed(:,l)=0.0d0           
     239c           ENDIF
     240           
    230241         ENDDO
    231242      ENDDO
     243
     244c     Passage du Flux au Flux pour un pas de temps (== kg.m-2)     
     245      F_sed(:,:)=F_sed(:,:)*ptimestep
    232246
    233247
    … …  
    243257c     Partie H2SO4l
    244258c     ~~~~~~~~~~~~
    245 c      CALL vlz_fi_par(n_lon,n_lev,zqi_sa,2.,m_lay,F_sed,wq)
    246259
    247260      DO l = 1, n_lev
    … …  
    250263     &                         F_sed(ig,l+1)*wgt_SA(ig,l+1)
    251264     &                       - F_sed(ig,l)*wgt_SA(ig,l))
    252      &                       / m_lay(ig,l)
     265     &                       / m_lay(ig,l)
     266c     On peut avoir theoriquement le cas ou on epuise tout le VMR present
     267             IF (zqi_sa(ig,l).LT.0.0D0) THEN
     268               PRINT*,'STOP sedimentation on epuise tout le VMR present'
     269               PRINT*,'couche',ig,'level',l
     270c               STOP
     271c              Ce n est pas juste mais il faudrait alors adapter les pas
     272c              de tps de la phys, microphys et chimie
     273c              car dans ce cas, c est comme si on epuisait la couche pour un pdtphys
     274c              mais en fait on l epuise pour un pdt<pdtphys
     275               zqi_sa(ig,l) = 0.0D0
     276             ENDIF
    253277            pdqsed(ig,l,1) = zqi_sa(ig,l) - pq(ig,l,i_h2so4liq)                       
    254278         ENDDO
    … …  
    257281c     Partie H2Ol
    258282c     ~~~~~~~~~~~
    259 c      CALL vlz_fi_par(n_lon,n_lev,zqi_wv,2.,m_lay,F_sed,wq)
    260283                     
    261284      DO l = 1, n_lev
    … …  
    265288     &                       - F_sed(ig,l)*(1. - wgt_SA(ig,l)))
    266289     &                       / m_lay(ig,l)
     290c     On peut avoir theoriquement le cas ou on epuise tout le VMR present
     291             IF (zqi_wv(ig,l).LT.0.0D0) THEN
     292               PRINT*,'STOP sedimentation on epuise tout le VMR present'
     293               PRINT*,'couche',ig,'level',l
     294c               STOP
     295c              Ce n est pas juste mais il faudrait alors adapter les pas
     296c              de tps de la phys, microphys et chimie
     297c              car dans ce cas, c est comme si on epuisait la couche pour un pdtphys
     298c              mais en fait on l epuise pour un pdt<pdtphys
     299               zqi_wv(ig,l) = 0.0D0
     300             ENDIF
    267301            pdqsed(ig,l,2) = zqi_wv(ig,l) - pq(ig,l,i_h2oliq)                   
    268302         ENDDO
    269303      ENDDO
    270 
    271304
    272305c               Save output file in 1D model
    … …  
    278311c       DO ig=1,n_lon
    279312c       WRITE(77,"(i4,','11(e15.8,','))") l,pdqsed(ig,l),zqi(ig,l),
    280 c     &         (wgt_h2so4(ig,l)*pq(ig,l,i_h2so4liq)+
    281 c     &         (1.-wgt_h2so4(ig,l))*pq(ig,l,i_h2oliq)),
     313c     &         (WH2SO4(ig,l)*pq(ig,l,i_h2so4liq)+
     314c     &         (1.-WH2SO4(ig,l))*pq(ig,l,i_h2oliq)),
    282315c     &         pq(ig,l,i_h2so4liq),pq(ig,l,i_h2oliq)
    283316c      ENDDO
    … …  
    288321      END
    289322
     323*******************************************************************************
     324      REAL FUNCTION VISCOSITY_CO2(temp)
     325c       Aurélien Stolzenbach 2015
     326c       Calcul de la viscosité dynamique du CO2 80°K -> 300°K
     327c       Viscosité dynamique en Pa.s
     328c       Source: Johnston & Grilly (1942)
     329
     330c       température en °K
     331        REAL, INTENT(IN) :: temp
     332       
     333        REAL :: denom, numer
     334       
     335c       Calcul de la viscosité dynamique grâce à la formule de Jones (Lennard-Jones (1924))
     336       
     337        numer = 200.**(2.27/4.27)-0.435
     338        denom = temp**(2.27/4.27)-0.435
     339       
     340        VISCOSITY_CO2 = (numer/denom)*1015.*(temp/200.)**(3./2.)
     341
     342c       convertion de Poises*1e7 -> Pa.s       
     343        VISCOSITY_CO2 = VISCOSITY_CO2*1.e-8     
     344
     345      END FUNCTION VISCOSITY_CO2
     346*******************************************************************************
     347
     348

  • trunk/LMDZ.VENUS/libf/phyvenus/new_cloud_venus.F

    r1305 r1442  
    1111!*
    1212!----------------------------------------------------------------------------
    13       SUBROUTINE new_cloud_venus(deltaT,NDTOT,
    14      + MEDIAN,GSTDEV,tt,
    15      + pp,ppwv,
    16      + mr_wv,mr_sa,
    17      + niv,
     13      SUBROUTINE new_cloud_venus(
     14     + nblev, nblon,
     15     + TT,PP,
    1816     + mrt_wv,mrt_sa,
    19      + WSA,
    20      + PSSA,SATPSSA,
    21      + RHOSASL)
    22 
    23 
    24 !      USE real16
     17     + mr_wv,mr_sa)
     18
    2519      USE chemparam_mod
    2620      IMPLICIT NONE
    27 
    28 !     Niveau (correspond pression, altitude fixe des couches nuageuses)
    29       INTEGER niv
    30 
    31 
    32 !     Aerosol and PSC variables:
    33       REAL
    34      +        WSA,WWV
    35 !      REAL  RMIN,RMAX
     21     
     22#include "YOMCST.h"
     23     
     24      INTEGER, INTENT(IN) :: nblon  ! nombre de points horizontaux
     25      INTEGER, INTENT(IN) :: nblev  ! nombre de couches verticales
     26     
    3627!----------------------------------------------------------------------------
    3728!     Ambient air state variables:
    38       REAL
    39      +        tt,pp,
    40      +        mr_wv,mr_sa,
    41      +        PPWV,PPSA,
    42      +        PSSA,SATPSSA
    43 
     29      REAL, INTENT(IN), DIMENSION(nblon,nblev) :: mrt_wv,mrt_sa,
     30     +                                            TT,PP
     31      REAL, INTENT(INOUT), DIMENSION(nblon,nblev) :: mr_wv,mr_sa
    4432!----------------------------------------------------------------------------
    45 !     Physical constants:
    46       REAL  MH2O,MH2SO4,MAIR,CWV,CSA !,CNA,MHNO3
    47       PARAMETER(
    48      +          MH2O=18.0153d-3,
    49 !     +          MHNO3=63.01d-3,
    50      +          MH2SO4=98.078d-3,
    51 !     +          MAIR=28.9644d-3,
    52 !AM Venus
    53      +          MAIR=43.45d-3,
    54      +          CWV=MAIR/MH2O,
    55 !     +          CNA=MAIR/MHNO3,
    56      +          CSA=MAIR/MH2SO4)
     33      INTEGER :: ilon, ilev, imode
     34!----------------------------------------------------------------------------
    5735!     Thermodynamic functions:
    58       REAL  ROSAS
    59 !AM
    60 !     Mathematical constants:
    61       REAL  PI
    62       PARAMETER(PI=3.1415926536)
    63      
    64 !----------------------------------------------------------------------------
    65 !     Time variables:
    66         REAL deltaT
     36      REAL :: RHODROPLET
    6737!----------------------------------------------------------------------------
    6838!     Auxilary variables:
    69       REAL 
    70      +     NDTOT,MEDIAN,GSTDEV,
    71      +     mrt_wv,mrt_sa,
    72      +     NH2SO4,NH2O,
    73      +     MASS,
    74      +     X0,X1,X2,X3,X4,X5,X6,
    75      +     RHOSASL,MSAL,
    76      +     waterps,condmass,RMH2S4
    77       REAL  H2SO4,H2SO4_liq,H2O_liq
    78       REAL  RSTDEV
    79       REAL  RMEDRA
    80       REAL  R2SO4
    81       REAL  DENSO4
    82       REAL  CONHS4
    83       REAL  H2O
    84       REAL  ACTSO4
    85       REAL  CONCM
    86       REAL  mrsa_conc
    87       REAL  RNLOG
    88 
     39      REAL :: NH2SO4,NH2O
     40      REAL :: H2SO4_liq,H2O_liq
     41      REAL :: CONCM
     42      REAL :: MCONDTOT
     43      REAL :: RMODE
     44      REAL :: WSAFLAG
     45      REAL :: K_SAV
     46!----------------------------------------------------------------------------
     47!     Ridder's Method variables:
     48      REAL :: WVMIN, WVMAX, WVACC
     49     
     50      INTEGER :: NBROOT
     51     
     52      INTEGER :: MAXITE
     53      PARAMETER(MAXITE=20)
     54
     55      INTEGER :: NBRAC
     56      PARAMETER(NBRAC=20)
     57     
     58      INTEGER :: FLAG
     59!----------------------------------------------------------------------------
     60
     61!----------------------------------------------------------------------------
     62!     External functions needed:
     63      REAL :: IRFRMWV
     64!----------------------------------------------------------------------------
     65
     66           
    8967! >>> Program starts here:
    9068
    91 
    92 !     mass of an H2SO4 molecule (g)
    93       RMH2S4=98.078/(6.02214129d23)
    94 
    9569!AM Venus
    96 !Here we call a subroutine that contains a nucleation parametrisation for stratosphere and
    97 !Venus and use that for calculating the number density of liquid sulfate aerosols. These
    98 !aerosols will then be given an equilibrium composition for the given size distribution
    99 ! calculates binary nucleation rate using revised theory, stauffer+binder&stauffer kinetics
    100  ! and   noppel hydrate correction
    101  ! t     temperature [K]
    102  ! rehu    relative humidity %/100 which means 100%=1
    103  ! rhoa  concentration of h2so4 vapour [1/m^3]
    104  ! x     mole fraction in the core of the critical cluster 
    105  ! nwtot total number of water molecules in the critical cluster
    106  ! natot total number of h2so4 molecules in the critical cluster
    107  ! rc    radius of the critical cluster core [m]
    108  ! jnuc  nucleation rate [1/m^3s]
     70! These aerosols will then be given an equilibrium composition for the given size distribution
    10971
    11072  ! Hanna Vehkamäki and Markku Kulmala and Ismo Napari
    11173  ! and Kari E. J. Lehtinen and Claudia Timmreck and Madis Noppel and Ari Laaksonen, 2002,
    11274  ! An improved parameterization for sulfuric acid/water nucleation rates for tropospheric
    113   !and stratospheric conditions, () J. Geophys. Res., 107, pp. 4622-4631
    114 
     75  !and stratospheric conditions, () J. Geophys. Res., 107, PP. 4622-4631
     76
     77!===========================================
     78!     Debut boucle sur niveau et lat,lon
     79!===========================================
     80!     Init, tous les points=0, cela met les niveaux > cloudmax et < cloudmin a 0
     81      NBRTOT(:,:,:)=0.0E+0
     82      WH2SO4(:,:)=0.0E+0
     83      rho_droplet(:,:)=0.0E+0
     84                 
     85      DO ilev=cloudmin, cloudmax
     86      DO ilon=1, nblon
     87         
     88!       Boucle sur les modes
     89        RMODE=0.0E+0
     90        K_SAV = 0.0
     91       
     92        DO imode=1, nbr_mode
     93          IF (K_MASS(ilon,ilev,imode).GT.K_SAV) THEN
     94!       RMODE est le rayon modal de la distribution en volume du mode le plus
     95!       representatif pour la Mtot
     96            RMODE=R_MEDIAN(ilon,ilev,imode)*
     97     &      EXP(2.*(DLOG(STDDEV(ilon,ilev,imode))**2.))
     98            K_SAV=K_MASS(ilon,ilev,imode)
     99          ENDIF
     100        ENDDO ! FIN boucle imode
     101
     102!       Initialisation des bornes pour WV
     103        WVMIN=1.E-90
     104        WVMAX=mrt_wv(ilon,ilev)
     105
     106!       Accuracy de WVeq
     107        WVACC=WVMAX*1.0E-3
     108                     
     109!       BRACWV borne la fonction f(WV) - WV = 0
     110!       de WV=0 à WV=WVtot on cherche l'intervalle où f(WV) - WV = 0
     111!       avec précisément f(WVliq de WSA<=WVinput) + WVinput - WVtot = 0
     112!       Elle fait appel à la fct/ssrtine ITERWV()
     113     
     114        CALL BRACWV(WVMIN,WVMAX,NBRAC,RMODE,
     115     &  mrt_wv(ilon,ilev),mrt_sa(ilon,ilev),TT(ilon,ilev),
     116     &  PP(ilon,ilev),FLAG,WSAFLAG,NBROOT)
     117       
     118        SELECT CASE(FLAG)
     119             
     120        CASE(1)
     121!         Cas NROOT=1 ou NROOT>1 mais dans un intervalle restreint WVTOT (cas courant)         
     122!       IRFRMWV Ridder's method pour trouver, sur [WVmin,WVmax], WVo tel que f(WVo) - WVo = 0
     123!       Elle fait appel ˆ la fct/ssrtine ITERWV()
     124           
     125          WH2SO4(ilon,ilev)=IRFRMWV(WVMIN,WVMAX,WVACC,MAXITE,RMODE,
     126     &    TT(ilon,ilev),PP(ilon,ilev),
     127     &    mrt_wv(ilon,ilev),mrt_sa(ilon,ilev),NBROOT)             
     128
     129          rho_droplet(ilon,ilev)=RHODROPLET(WH2SO4(ilon,ilev),
     130     &    TT(ilon,ilev))
     131
     132!          IF (rho_droplet(ilon,ilev).LT.1100.) THEN
     133!            PRINT*,'PROBLEM RHO_DROPLET'
     134!            PRINT*,'rho_droplet',rho_droplet(ilon,ilev)
     135!            PRINT*,'T',TT(ilon,ilev),'WSA',WH2SO4(ilon,ilev)
     136!            PRINT*,'RHODROPLET',RHODROPLET(WH2SO4(ilon,ilev),
     137!     &      TT(ilon,ilev))
     138!            PRINT*,'FLAG',FLAG,'NROOT',NBROOT
     139!            STOP
     140!          ENDIF
     141               
     142          CONCM= PP(ilon,ilev)/(1.3806488E-23*TT(ilon,ilev)) !air number density, molec/m3
     143
     144            NH2SO4=mrt_sa(ilon,ilev)*CONCM
     145            NH2O=mrt_wv(ilon,ilev)*CONCM
     146
     147          CALL CALCM_SAT(NH2SO4,NH2O,WH2SO4(ilon,ilev),
     148     &       rho_droplet(ilon,ilev),TT(ilon,ilev),
     149     &       H2SO4_liq,H2O_liq,MCONDTOT)
     150
     151!       Boucle sur les modes
     152          DO imode=1, nbr_mode
     153            IF (K_MASS(ilon,ilev,imode).GT.0.) THEN       
     154              NBRTOT(ilon,ilev,imode)= 1.E-6*3./(4.*RPI)*
     155     &        K_MASS(ilon,ilev,imode)*MCONDTOT*
     156     &        EXP(-4.5*DLOG(STDDEV(ilon,ilev,imode))**2.)/
     157     &        (R_MEDIAN(ilon,ilev,imode)**3.)
     158            ELSE
     159              NBRTOT(ilon,ilev,imode)=0.0E+0
     160            ENDIF     
     161          ENDDO   
     162
     163!       Passage de #/m3 en VMR
     164          H2O_liq=H2O_liq/CONCM
     165          H2SO4_liq=H2SO4_liq/CONCM
     166
     167          mr_wv(ilon,ilev)=mrt_wv(ilon,ilev)-H2O_liq
     168          mr_sa(ilon,ilev)=mrt_sa(ilon,ilev)-H2SO4_liq
     169       
     170!          Problemes quand on a condense tout, on peut obtenir des -1e-24
     171!               aprs la soustraction et conversion de ND ˆ VMR
     172          IF (mr_wv(ilon,ilev).LE.0.0) mr_wv(ilon,ilev)=1.0E-30         
     173          IF (mr_sa(ilon,ilev).LE.0.0) mr_sa(ilon,ilev)=1.0E-30
     174
     175
     176
     177        CASE(2)
     178!       Cas NROOT=0 mais proche de 0
     179
     180          WH2SO4(ilon,ilev)=WSAFLAG
     181         
     182          rho_droplet(ilon,ilev)=RHODROPLET(WH2SO4(ilon,ilev),
     183     &    TT(ilon,ilev))         
     184
     185!     ATTENTION ce IF ne sert a rien en fait, juste a retenir une situation
     186!     ubuesque dans mon code ou sans ce IF les valeurs de rho_droplets sont
     187!     incohŽrentes avec TT et WH2SO4 (a priori lorsque NTOT=0)
     188!     Juste le fait de METTRE un IF fait que rho_droplet a la bonne valeur
     189!     donne par RHODROPLET (cf test externe en Python), sinon, la valeur est trop
     190!     basse (de l'ordre de 1000 kg/m3) et correspond parfois ˆ la valeur avec
     191!     WSA=0.1 (pas totalement sur)
     192!     En tous cas, incoherent avec ce qui est attendue pour le WSA et T donneeŽ
     193!     La version avec le IF (rho<1100 & WSA>0.1) est CORRECTE, rho_droplet a
     194!     la bonne valeur (tests externes Python confirment)
     195     
     196          IF ((rho_droplet(ilon,ilev).LT.1100.).AND.
     197     &      (WH2SO4(ilon,ilev).GT.0.1))THEN
     198            PRINT*,'PROBLEM RHO_DROPLET'
     199            PRINT*,'rho_droplet',rho_droplet(ilon,ilev)
     200            PRINT*,'T',TT(ilon,ilev),'WSA',WH2SO4(ilon,ilev)
     201            PRINT*,'RHODROPLET',RHODROPLET(WH2SO4(ilon,ilev),
     202     &      TT(ilon,ilev))
     203            PRINT*,'FLAG',FLAG,'NROOT',NBROOT
     204            STOP
     205          ENDIF
    115206 
    116              IF (niv.GE.cloudmin .AND. niv.LE.cloudmax) THEN
    117 
    118               CALL WGTGV(MEDIAN,TT,PPWV,WSA,RHOSASL,MSAL)         
    119 
    120               R2SO4=WSA*100.
    121 !     R2SO4 -> activity coeff (ACTSO4)
    122               CALL STRAACT(R2SO4,ACTSO4)
    123 !              write(*,*) 'R2SO4,ACTSO4 ',R2SO4,ACTSO4
    124 !     R2SO4, T -> aerosol density (R2SO4)
    125 
    126               DENSO4=ROSAS(TT,WSA)
    127 !       units g/cm3 required by the following routines
    128               DENSO4=DENSO4*1.d-3           
    129 
    130               CONCM= (PP)/(1.3806488D-23*TT) !air number density, molec/m3? CHECK UNITS!
    131               CONCM=CONCM*1.d-6 !in molec./cm3
    132 
    133                   NH2SO4=mrt_sa*CONCM
    134                   NH2O=mrt_wv*CONCM
    135 
    136               CALL CALNLOG_SAT(ACTSO4,NH2SO4,NH2O,WSA,DENSO4,GSTDEV,
    137      +             MEDIAN,TT,RNLOG,H2SO4_liq,H2O_liq,
    138      +           PSSA,SATPSSA)
    139 
    140                  
    141 !                 NDTOT nbr # pour 1cm3
    142               NDTOT=RNLOG
    143 
    144 !      IF ((NDTOT.GT.1.0d+3).OR.
    145 !     & ((niv.GT.45).AND.(mr_wv.GT.1.0e-6))) THEN
    146 !      PRINT*,'PROBLEME GENERAL AVEC CES PUTAINS DE ROUTINES'
    147 !      PRINT*,'H2SO4COND',H2SO4_liq/CONCM,'H2SO4',mr_sa
    148 !      PRINT*,'DND2',SATPSSA*1.0d-6/(1.38D-23*TT)
    149 !      PRINT*,'NH2O',NH2O,'NH2SO4',NH2SO4
    150 !      PRINT*,'H2OCOND',H2O_liq/CONCM,'H2O',mr_wv
    151 !      PRINT*,'H2SO4tot',mrt_sa,'H2Otot',mrt_wv
    152 !      PRINT*,'MEDIAN',MEDIAN,'GSTDEV',GSTDEV
    153 !      PRINT*,'NBRTOT',NDTOT,'level',niv,'WSA',WSA
    154 !      STOP
    155 !      ENDIF
    156      
    157      
    158           mr_wv=mrt_wv-H2O_liq/CONCM
    159           mr_sa=mrt_sa-H2SO4_liq/CONCM
    160207         
    161          
     208          CONCM= PP(ilon,ilev)/(1.3806488E-23*TT(ilon,ilev)) !air number density, molec/m3
     209
     210            NH2SO4=mrt_sa(ilon,ilev)*CONCM
     211            NH2O=mrt_wv(ilon,ilev)*CONCM
     212
     213          CALL CALCM_SAT(NH2SO4,NH2O,WH2SO4(ilon,ilev),
     214     &       rho_droplet(ilon,ilev),TT(ilon,ilev),
     215     &       H2SO4_liq,H2O_liq,MCONDTOT)
     216
     217!       Boucle sur les modes
     218          DO imode=1, nbr_mode
     219            IF (K_MASS(ilon,ilev,imode).GT.0.) THEN       
     220              NBRTOT(ilon,ilev,imode)= 1.E-6*3./(4.*RPI)*
     221     &        K_MASS(ilon,ilev,imode)*MCONDTOT*
     222     &        EXP(-4.5*DLOG(STDDEV(ilon,ilev,imode))**2.)/
     223     &        (R_MEDIAN(ilon,ilev,imode)**3.)
     224            ELSE
     225              NBRTOT(ilon,ilev,imode)=0.0E+0
     226            ENDIF     
     227          ENDDO   
     228
     229!       Passage de #/m3 en VMR
     230          H2O_liq=H2O_liq/CONCM
     231          H2SO4_liq=H2SO4_liq/CONCM
     232
     233          mr_wv(ilon,ilev)=mrt_wv(ilon,ilev)-H2O_liq
     234          mr_sa(ilon,ilev)=mrt_sa(ilon,ilev)-H2SO4_liq
     235       
    162236!          Problmes quand on a condense tout, on peut obtenir des -1e-24
    163237!               aprs la soustraction et conversion de ND ˆ VMR
    164           IF (mr_wv.LT.0.0) THEN
    165           mr_wv=0.0d0
    166           END IF
     238          IF (mr_wv(ilon,ilev).LE.0.0) mr_wv(ilon,ilev)=1.0E-30         
     239          IF (mr_sa(ilon,ilev).LE.0.0) mr_sa(ilon,ilev)=1.0E-30
    167240         
    168           IF (mr_sa.LT.0.0) THEN
    169           mr_sa=0.0d0
    170           END IF
     241        CASE(3)
     242!         Cas 0 NROOT 
     243            mr_wv(ilon,ilev)=mrt_wv(ilon,ilev)
     244            mr_sa(ilon,ilev)=mrt_sa(ilon,ilev)
     245            rho_droplet(ilon,ilev)=0.0E+0
     246            WH2SO4(ilon,ilev)=0.0E+0
     247            DO imode=1, nbr_mode
     248              NBRTOT(ilon,ilev,imode)=0.0E+0   
     249            ENDDO   
     250
     251        END SELECT
     252      ENDDO   !FIN boucle ilon
     253      ENDDO   !FIN boucle ilev
     254             
     255      END SUBROUTINE new_cloud_venus
     256     
     257     
     258!*****************************************************************************
     259!*    SUBROUTINE ITERWV()                                         
     260      SUBROUTINE ITERWV(WV,WVLIQ,WVEQOUT,WVTOT,WSAOUT,SATOT,
     261     + TAIR,PAIR,RADIUS)
     262!*****************************************************************************
     263!* Cette routine est la solution par itŽration afin de trouver WSA pour un WV,
     264!* et donc LPPWV, donnŽ. Ce qui nous donne egalement le WV correspondant au
     265!* WSA solution   
     266!* For VenusGCM by A. Stolzenbach 07/2014
     267!* OUTPUT: WVEQ et WSAOUT
     268
     269      IMPLICIT NONE
     270      REAL, INTENT(IN) :: WV, WVTOT, SATOT, TAIR, PAIR, RADIUS
     271     
     272      REAl, INTENT(OUT) :: WVEQOUT, WSAOUT, WVLIQ
     273     
     274      REAL :: WSAMIN, WSAMAX, WSAACC
     275      PARAMETER(WSAACC=0.001)
     276     
     277      REAL :: LPPWV
     278     
     279      INTEGER :: MAXITSA, NBRACSA, NBROOT
     280      PARAMETER(MAXITSA=20)
     281      PARAMETER(NBRACSA=20)
     282     
     283      LOGICAl :: FLAG1,FLAG2
     284
     285!     External Function     
     286      REAl :: IRFRMSA, WVCOND
     287     
     288      IF (RADIUS.LT.1E-30) THEN
     289        PRINT*,'RMODE == 0 FLAG 3'
     290        STOP
     291      ENDIF
     292!     Initialisation WSA=[0.1,1.0]     
     293      WSAMIN=0.1
     294      WSAMAX=1.0
     295           
     296      LPPWV=DLOG(PAIR*WV)
     297           
     298!     Appel Bracket de KEEQ         
     299      CALL BRACWSA(WSAMIN,WSAMAX,NBRACSA,RADIUS,TAIR,
     300     &     LPPWV,FLAG1,FLAG2,NBROOT)
     301           
     302      IF ((.NOT.FLAG1).AND.(.NOT.FLAG2).AND.(NBROOT.EQ.1)) THEN         
     303!          Appel Ridder's Method
     304
     305        WSAOUT=IRFRMSA(WSAMIN,WSAMAX,WSAACC,MAXITSA,
     306     &  RADIUS,TAIR,PAIR,LPPWV,NBROOT)
     307!              IF (WSAOUT.EQ.1.0) WSAOUT=0.999999
     308!              IF (WSAOUT.LT.0.1) WSAOUT=0.1
     309
     310!       Si BRACWSA ne trouve aucun ensemble solution KEEQ=0 on fixe WSA a 0.9999 ou 0.1
     311      ELSE
     312        IF (FLAG1.AND.(.NOT.FLAG2)) WSAOUT=0.999999
     313        IF (FLAG2.AND.(.NOT.FLAG1)) WSAOUT=WSAMIN
     314        IF (FLAG1.AND.FLAG2) THEN
     315          PRINT*,'FLAGs BARCWSA tous TRUE'
     316          STOP
     317        ENDIF
     318      ENDIF
     319           
     320         
     321!     WVEQ output correspondant a WVliq lie a WSA calcule
     322      WVLIQ=WVCOND(WSAOUT,TAIR,PAIR,SATOT)
     323      WVEQOUT=(WVLIQ+WV)/WVTOT-1.0
     324                           
     325      END SUBROUTINE ITERWV
     326
     327
     328!*****************************************************************************
     329!*    SUBROUTINE BRACWV()                                         
     330      SUBROUTINE BRACWV(XA,XB,N,RADIUS,WVTOT,SATOT,TAIR,PAIR,
     331     +           FLAGWV,WSAFLAG,NROOT)
     332!*****************************************************************************
     333!* Bracket de ITERWV
     334!* From Numerical Recipes     
     335!* Adapted for VenusGCM A. Stolzenbach 07/2014
     336!* X est WVinput
     337!* OUTPUT: XA et XB     
     338
     339      IMPLICIT NONE
     340
     341      REAL, INTENT(IN) :: WVTOT,SATOT,RADIUS,TAIR,PAIR
     342      INTEGER, INTENT(IN) :: N
     343     
     344      REAL, INTENT(INOUT) :: XA,XB
     345      REAL, INTENT(OUT) :: WSAFLAG
     346     
     347      INTEGER :: I,J
     348     
     349      INTEGER, INTENT(OUT) :: NROOT
     350     
     351      REAL :: FP, FC, X, WVEQ, WVLIQ, WSAOUT
     352      REAL :: XMAX,XMIN,WVEQACC
     353     
     354      INTEGER, INTENT(OUT) :: FLAGWV
     355
     356!     WVEQACC est le seuil auquel on accorde un WSA correct meme
     357!     si il ne fait pas partie d'une borne. Utile quand le modele
     358!     s'approche de 0 mais ne l'atteint pas.
     359      WVEQACC=1.0E-3
     360       
     361      FLAGWV=1
     362
     363      NROOT=0
     364
     365      X=XA
     366      XMAX=XB
     367      XMIN=XA
     368
     369!     CAS 1 On borne la fonction (WVEQ=0)
     370     
     371      CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT,TAIR,PAIR,RADIUS)
     372      FP=WVEQ
     373     
     374      DO I=1,N-1
     375         X=(1.-DLOG(REAL(N-I))/DLOG(REAL(N)))*XMAX
     376         CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT,TAIR,PAIR,RADIUS)
     377         FC=WVEQ
     378
     379          IF ((FP*FC).LT.0.0) THEN 
     380            NROOT=NROOT+1
     381!           Si NROOT>1 on place la borne sup output ˆ la borne min du calcul en i             
     382            IF (NROOT.GT.1) THEN
     383               XB=(1.-DLOG(REAL(N-I+1))/DLOG(REAL(N)))*XMAX
     384            ENDIF
     385
     386            IF (I.EQ.1) THEN
     387              XA=XMIN
     388            ELSE
     389              XA=(1.-DLOG(REAL(N-I+1))/DLOG(REAL(N)))*XMAX
     390            ENDIF
     391            XB=X
     392         ENDIF         
     393         FP=FC
     394      ENDDO
     395
     396!     CAS 2 on refait la boucle pour tester si WVEQ est proche de 0
     397!     avec le seuil WVEQACC
     398      IF (NROOT.EQ.0) THEN
     399         X=XMIN
     400         CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT,
     401     +   TAIR,PAIR,RADIUS)
     402          DO J=1,N-1
     403             X=(1.-DLOG(REAL(N-J))/DLOG(REAL(N)))*XMAX
     404             CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSAOUT,SATOT,
     405     +       TAIR,PAIR,RADIUS)
     406             
     407             IF (ABS(WVEQ).LE.WVEQACC) THEN
     408                WSAFLAG=WSAOUT
     409                FLAGWV=2
     410                RETURN
     411             ENDIF
     412          ENDDO
     413
     414!     CAS 3 Pas de borne, WVEQ jamais proche de 0         
     415          FLAGWV=3
     416          RETURN
     417       ENDIF
     418
     419      END SUBROUTINE BRACWV
     420     
     421!*****************************************************************************
     422!*    SUBROUTINE BRACWSA()                                         
     423      SUBROUTINE BRACWSA(XA,XB,N,RADIUS,TAIR,LPPWVINP,FLAGH,FLAGL,
     424     +           NROOT)
     425!*****************************************************************************
     426!* Bracket de KEEQ
     427!* From Numerical Recipes     
     428!* Adapted for VenusGCM A. Stolzenbach 07/2014
     429     
     430      IMPLICIT NONE
     431
     432!----------------------------------------------------------------------------
     433!     External functions needed:
     434      REAl KEEQ
     435!----------------------------------------------------------------------------
     436
     437      REAL, INTENT(IN) :: RADIUS,TAIR,LPPWVINP
     438      INTEGER, INTENT(IN) :: N
     439     
     440      REAL, INTENT(INOUT) :: XA,XB
     441     
     442      INTEGER, INTENT(OUT) ::  NROOT
     443
     444      INTEGER :: I, J
     445     
     446      REAL :: DX, FP, FC, X
     447     
     448      LOGICAL, INTENT(OUT) :: FLAGH,FLAGL
     449   
     450     
     451      FLAGL=.FALSE.
     452      FLAGH=.FALSE.   
     453      NROOT=0
     454      DX=(XB-XA)/N
     455      X=XA
     456      FP=KEEQ(RADIUS,TAIR,X,LPPWVINP)
     457     
     458      DO I=1,N
     459         X=X+DX
     460         FC=KEEQ(RADIUS,TAIR,X,LPPWVINP)
     461         
     462         IF ((FP*FC).LE.0.) THEN
     463            NROOT=NROOT+1
     464            XA=X-DX
     465            XB=X
     466!            RETURN
     467!            IF (NROOT.GT.1) THEN
     468!               PRINT*,'On a plus d1 intervalle KEEQ=0'
     469!               PRINT*,'Probleme KEEQ=0 => 1 racine en theorie'
     470!               X=X-(I*DX)
     471!               FP=KEEQ(RADIUS,TAIR,X,LPPWVINP)
     472!               PRINT*,'KEEQ(WSA)',FP,X,TAIR
     473!               DO J=1,N
     474!                 X=X+DX
     475!                FP=KEEQ(RADIUS,TAIR,X,LPPWVINP)
     476!                PRINT*,'KEEQ(WSA)',FP,X
     477!               ENDDO
     478!               STOP
     479!            ENDIF
     480         ENDIF
     481         
     482         FP=FC
     483      ENDDO
     484     
     485      IF (NROOT.EQ.0) THEN
     486!         PRINT*,'On a 0 intervalle KEEQ=0'
     487!         PRINT*,'Probleme KEEQ=0 => 1 racine en theorie'
     488!         PRINT*,'XA',XA,'KEEQ',KEEQ(RADIUS,TAIR,XA,LPPWVINP)
     489!         PRINT*,'XB',XB,'KEEQ',KEEQ(RADIUS,TAIR,XB,LPPWVINP)
     490!         PRINT*,'TT',TAIR
     491!         PRINT*,'RADIUS',RADIUS
     492!         PRINT*,'NBRAC',N
     493!         STOP
     494         
     495!         X=XA
     496!         FP=KEEQ(RADIUS,TAIR,X,LPPWVINP)
     497!         PRINT*,'KEEQ(WSA)',FP,X,TAIR
     498!         DO I=1,N
     499!           X=X+DX
     500!           FP=KEEQ(RADIUS,TAIR,X,LPPWVINP)
     501!           PRINT*,'KEEQ(WSA)',FP,X,TAIR
     502!         ENDDO
     503
     504
     505!        Test determine la tendance globale KEEQ sur [WSAMIN,WSAMAX]       
     506         IF ((ABS(KEEQ(RADIUS,TAIR,XA,LPPWVINP))-
     507     &    ABS(KEEQ(RADIUS,TAIR,XB,LPPWVINP))).GT.0.0) FLAGH=.TRUE.
     508!        On fixe flag low TRUE pour WSA = 0.1
     509         IF ((ABS(KEEQ(RADIUS,TAIR,XA,LPPWVINP))-
     510     &    ABS(KEEQ(RADIUS,TAIR,XB,LPPWVINP))).LT.0.0) FLAGL=.TRUE.
     511!        STOP
     512      ENDIF
     513     
     514      END SUBROUTINE BRACWSA
     515         
     516           
     517!*****************************************************************************
     518!*     REAL FUNCTION WVCOND()                                         
     519      REAL FUNCTION WVCOND(WSA,T,P,SAt)
     520!*****************************************************************************
     521!* Condensation de H2O selon WSA, T et P et H2SO4tot
     522!*
     523!* Adapted for VenusGCM A. Stolzenbach 07/2014
     524!     INPUT:
     525!     SAt  : VMR of total H2SO4
     526!     WSA: aerosol H2SO4 weight fraction (fraction)
     527!     T: temperature (K)
     528!     P: pressure (Pa)
     529!     OUTPUT:
     530!       WVCOND : VMR H2O condense
     531
     532!      USE chemparam_mod
     533     
     534      IMPLICIT NONE
     535
     536      REAL, INTENT(IN) :: SAt, WSA
     537      REAL, INTENT(IN) :: T, P
     538
     539!     working variables
     540      REAL SA, WV
     541      REAL  DND2,pstand,lpar,acidps
     542      REAL  x1, satpacid
     543      REAL , DIMENSION(2):: act
     544      REAL  CONCM
     545      REAL  NH2SO4
     546      REAL  H2OCOND, H2SO4COND
     547   
     548
     549      CONCM= (P)/(1.3806488E-23*T) !air number density, molec/m3? CHECK UNITS!
     550
     551        NH2SO4=SAt*CONCM
     552     
     553      pstand=1.01325E+5 !Pa  1 atm pressure
     554
     555        x1=(WSA/98.08)/(WSA/98.08 + ((1.-WSA)/18.0153))
     556
     557        CALL zeleznik(x1,T,act)
     558
     559!pure acid satur vapor pressure
     560        lpar= -11.695+DLOG(pstand) ! Zeleznik
     561        acidps=1/360.15-1.0/T+0.38/545.
     562     & *(1.0+DLOG(360.15/T)-360.15/T)
     563        acidps = 10156.0*acidps +lpar
     564        acidps = DEXP(acidps)    !Pa
     565
     566!acid sat.vap.PP over mixture (flat surface):
     567        satpacid=act(2)*acidps ! Pa
     568
     569!       Conversion from Pa to N.D #/m3
     570        DND2=satpacid/(1.3806488E-23*T)
     571               
     572!       H2SO4COND N.D #/m3 condensee ssi H2SO4>H2SO4sat
     573        IF (NH2SO4.GT.DND2) THEN
     574        H2SO4COND=NH2SO4-DND2
     575!       calcul de H2O cond correspondant a H2SO4 cond
     576        H2OCOND=H2SO4COND*98.078*(1.0-WSA)/(18.0153*WSA)
     577
     578!       Si on a H2SO4<H2SO4sat on ne condense rien, VMR = 1.0E-30
     579        ELSE
     580        H2OCOND=1.0E-30*CONCM
     581        END IF
     582
     583!*****************************************************
     584!     ATTENTION: Ici on ne prends pas en compte
     585!                si H2O en defaut!
     586!                On veut la situation theorique
     587!                a l'equilibre
     588!*****************************************************         
     589!       Test si H2O en defaut H2Ocond>H2O dispo
     590!       IF ((H2OCOND.GT.NH2O).AND.(NH2SO4.GE.DND2)) THEN
    171591       
    172        
    173              ELSE
    174 !             PRINT*,'**** NDTOT OUT CLOUD ****'
    175              NDTOT=0.0d0
    176              WSA=0.0d0
    177              PSSA=0.0d0
    178              SATPSSA=0.0d0
    179              RHOSASL=0.0d0
    180 !             write(*,*) 'NDTOT = 0.0!!'
    181              END IF
     592!       On peut alors condenser tout le H2O dispo
     593!       H2OCOND=NH2O
     594!       On met alors egalement a jour le H2SO4 cond correspondant au H2O cond
     595!       H2SO4COND=H2OCOND*18.0153*WSA/(98.078*(1.0-WSA))
     596           
     597!      END IF
     598
     599!     Calcul de H2O condensŽe VMR         
     600      WVCOND=H2OCOND/CONCM
     601     
     602      END FUNCTION WVCOND
     603
     604!*****************************************************************************
     605!*     REAL FUNCTION IRFRMWV()                                         
     606      REAL      FUNCTION IRFRMWV(X1,X2,XACC,MAXIT,RADIUS,TAIR,PAIR,
     607     + WVTOT,SATOT,NROOT)
     608!*****************************************************************************
     609!* Iterative Root Finder Ridder's Method for Water Vapor calculus
     610!* From Numerical Recipes
     611!* Adapted for VenusGCM A. Stolzenbach 07/2014
     612!*
     613!* Les iterations sur [X1,X2] sont [WV1,WV2]
     614!* la variable X est WV
     615!* IRFRMWV sort en OUTPUT : WSALOC pour ITERWV=0 (ou WVEQ=0)
     616
     617      IMPLICIT NONE
     618     
     619      REAL, INTENT(IN) ::    X1, X2
     620      REAL, INTENT(IN) ::    XACC
     621      INTEGER, INTENT(IN) :: MAXIT,NROOT
     622     
     623!     LOCAL VARIABLES
     624      REAL :: XL, XH, XM, XNEW, X
     625      REAL :: WSALOC, WVEQ, WVLIQ
     626      REAL :: FL, FH, FM, FNEW
     627      REAL :: ANS, S, FSIGN
     628      INTEGER i
     629     
     630!     External variables needed:
     631      REAL, INTENT(IN) :: TAIR,PAIR
     632      REAL, INTENT(IN) :: WVTOT,SATOT
     633      REAL, INTENT(IN) :: RADIUS
     634
     635     
     636!     Initialisation
     637      X=X1
     638      CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,TAIR,PAIR,RADIUS)
     639      FL=WVEQ
     640      X=X2
     641      CALL ITERWV(X,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,TAIR,PAIR,RADIUS)
     642      FH=WVEQ
     643     
     644!     Test Bracketed values
     645      IF (((FL.LT.0.).AND.(FH.GT.0.)).OR.
     646     &   ((FL.GT.0.).AND.(FH.LT.0.)))
     647     &  THEN
     648         XL=X1
     649         XH=X2
     650         ANS=-9.99e99
     651         
     652         DO i=1, MAXIT
     653            XM=0.5*(XL+XH)
     654            CALL ITERWV(XM,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,
     655     &       TAIR,PAIR,RADIUS)
     656            FM=WVEQ
     657            S=SQRT(FM*FM-FL*FH)
     658           
     659            IF (S.EQ.0.0) THEN
     660               IRFRMWV=WSALOC
     661               RETURN
     662            ENDIF   
    182663             
    183       END
    184 
    185 
    186 ******************************************************************************
    187 *     SUBROUTINE WGTGV(RADIUS,TAIR,PPWV,WSAS,RHOSAS,MSA)
    188 ******************************************************************************
    189 *
    190 *     This subroutine calculates the acid mass fraction, density, and
    191 *     mass of sulfuric acid in a single aerosol droplet of a specified
    192 *     radius in equilibrium with ambient water vapor partial pressure
    193 *     and temperature.
    194 *
    195 *     The calculation is performed by iteration of
    196 *        ln(PPWV) - [(2Mh2o sigma)/(R T r rho) - ln(ph2osa)] = 0
    197 *     using the secant method. Vapor pressures by Gmitro and Vermeulen
    198 *     (PWVSAS_GV) are used. 
    199 *
    200 *     Input/output variables:
    201 *     REAL(KIND=4)  RADIUS,TAIR,PPWV,WSAS,RHOSAS,MSA
    202 *
    203 *     Input:       
    204 *         RADIUS:  m         Radius of aerosol droplet
    205 *         TAIR:    K         Temperature of ambient air
    206 *         PPWV:    Pa        Partial pressure of ambient water vapor
    207 *
    208 *     Output:
    209 *         WSAS:              mass fraction of sulfuric acid. [0.1;1]
    210 *         RHOSAS:  kg/m**3   Density of sulfuric acid solution droplet
    211 *         MSA:     kg        Mass of sulfuric acid in droplet
    212 *          CALL WGTGV(PTSIZE(25,1),TAIR,PPPWV,WSA,MSA1)
    213       SUBROUTINE WGTGV(RADIUS,TAIR,PPWV,WSAS,RHOSAS,MSA)
    214 !
    215 !      USE real16
     664            IF (FL.GT.FH) THEN
     665               FSIGN=1.0
     666            ELSE
     667               FSIGN=-1.0
     668            ENDIF
     669           
     670            XNEW=XM+(XM-XL)*(FSIGN*FM/S)
     671           
     672            IF (ABS(XNEW-ANS).LE.XACC) THEN
     673               IRFRMWV=WSALOC
     674               RETURN
     675            ENDIF   
     676           
     677            ANS=XNEW
     678            CALL ITERWV(ANS,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,
     679     &       TAIR,PAIR,RADIUS)
     680            FNEW=WVEQ
     681           
     682            IF (FNEW.EQ.0.0) THEN
     683               IRFRMWV=WSALOC
     684               RETURN
     685            ENDIF
     686           
     687            IF (SIGN(FM, FNEW).NE.FM) THEN
     688               XL=XM
     689               FL=FM
     690               XH=ANS
     691               FH=FNEW
     692               ELSEIF (SIGN(FL, FNEW).NE.FL) THEN
     693                  XH=ANS
     694                  FH=FNEW
     695               ELSEIF (SIGN(FH, FNEW).NE.FH) THEN
     696                  XL=ANS
     697                  FL=FNEW
     698               ELSE
     699                  PRINT*,'PROBLEM IRFRMWV dans new_cloud_venus'
     700                  PRINT*,'you shall not PAAAAAASS'
     701                  STOP
     702            ENDIF
     703         ENDDO
     704         PRINT*,'Paaaaas bien MAXIT atteint'
     705         PRINT*,'PROBLEM IRFRMWV dans new_cloud_venus'
     706         PRINT*,'you shall not PAAAAAASS'
     707         XL=X1
     708         XH=X2
     709         ANS=-9.99e99
     710         
     711         DO i=1, MAXIT
     712            XM=0.5*(XL+XH)
     713            CALL ITERWV(XM,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,
     714     &       TAIR,PAIR,RADIUS)
     715            FM=WVEQ
     716            S=SQRT(FM*FM-FL*FH)
     717            IF (FL.GT.FH) THEN
     718               FSIGN=1.0
     719            ELSE
     720               FSIGN=-1.0
     721            ENDIF
     722           
     723            XNEW=XM+(XM-XL)*(FSIGN*FM/S)     
     724           
     725            ANS=XNEW
     726            CALL ITERWV(ANS,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,
     727     &       TAIR,PAIR,RADIUS)
     728            FNEW=WVEQ
     729            PRINT*,'WVliq',WVLIQ,'WVtot',WVTOT,'WVeq',WVEQ
     730            PRINT*,'WSA',WSALOC,'SAtot',SATOT
     731            PRINT*,'T',TAIR,'P',PAIR
     732
     733            IF (SIGN(FM, FNEW).NE.FM) THEN
     734               XL=XM
     735               FL=FM
     736               XH=ANS
     737               FH=FNEW
     738               ELSEIF (SIGN(FL, FNEW).NE.FL) THEN
     739                  XH=ANS
     740                  FH=FNEW
     741               ELSEIF (SIGN(FH, FNEW).NE.FH) THEN
     742                  XL=ANS
     743                  FL=FNEW
     744               ELSE
     745                  PRINT*,'PROBLEM IRFRMWV dans new_cloud_venus'
     746                  PRINT*,'you shall not PAAAAAASS TWIIICE???'
     747                  STOP
     748            ENDIF
     749         ENDDO
     750         STOP
     751      ELSE
     752         PRINT*,'IRFRMWV must be bracketed'
     753         PRINT*,'NROOT de BRACWV', NROOT
     754         IF (ABS(FL).LT.XACC) THEN
     755         PRINT*,'IRFRMWV FL == 0',FL
     756         PRINT*,'X1',X1,'X2',X2,'FH',FH
     757           CALL ITERWV(X1,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,
     758     &      TAIR,PAIR,RADIUS)
     759           IRFRMWV=WSALOC
     760         RETURN
     761         ENDIF
     762         IF (ABS(FH).LT.XACC) THEN
     763         PRINT*,'IRFRMWV FH == 0',FH
     764         PRINT*,'X1',X1,'X2',X2,'FL',FL
     765           CALL ITERWV(X2,WVLIQ,WVEQ,WVTOT,WSALOC,SATOT,
     766     &      TAIR,PAIR,RADIUS)
     767           IRFRMWV=WSALOC
     768         RETURN
     769         ENDIF
     770         IF ((ABS(FL).GT.XACC).AND.(ABS(FH).GT.XACC)) THEN
     771           PRINT*,'STOP dans IRFRMWV avec rien == 0'
     772           PRINT*,'X1',X1,'X2',X2
     773           PRINT*,'Fcalc',FL,FH
     774           PRINT*,'T',TAIR,'P',PAIR,'R',RADIUS
     775           STOP   
     776         ENDIF
     777         IF ((ABS(FL).LT.XACC).AND.(ABS(FH).LT.XACC)) THEN
     778           PRINT*,'STOP dans IRFRMWV Trop de solution < WVACC'
     779           PRINT*,FL,FH
     780           STOP   
     781         ENDIF
     782         
     783         
     784      ENDIF
     785!  FIN Test Bracketed values
     786       
     787      END FUNCTION IRFRMWV
     788                 
     789!*****************************************************************************
     790!*     REAL FUNCTION IRFRMSA()                                         
     791      REAL      FUNCTION IRFRMSA(X1,X2,XACC,MAXIT,RADIUS,TAIR,PAIR,LPPWV,
     792     +               NB)
     793!*****************************************************************************
     794!* Iterative Root Finder Ridder's Method for Sulfuric Acid calculus
     795!* From Numerical Recipes
     796!* Adapted for VenusGCM A. Stolzenbach 07/2014
     797!*
     798!* Les iterations sur [X1,X2] sont [WSA1,WSA2]
     799!* la variable X est WSA
     800!* IRFRMSA sort en OUTPUT : WSA pour KEEQ=0
     801
    216802      IMPLICIT NONE
    217 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    218 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    219 !     + (1.0_sp_k))
    220 
    221       REAL   RADIUS,TAIR,PPWV,WSAS,RHOSAS,MSA
    222 !
     803     
     804      REAL, INTENT(IN) ::    X1, X2
     805      REAL, INTENT(IN) ::    XACC
     806      INTEGER, INTENT(IN) :: MAXIT, NB
     807     
     808!     LOCAL VARIABLES
     809      REAL XL, XH, XM, XNEW
     810      REAL Fl, FH, FM, FNEW
     811      REAL ANS, S, FSIGN
     812      INTEGER i
     813     
     814!     External variables needed:
     815      REAL, INTENT(IN) :: TAIR,PAIR
     816      REAL, INTENT(IN) :: LPPWV
     817      REAL, INTENT(IN) :: RADIUS
     818     
     819!     External functions needed:
     820      REAL KEEQ
     821
     822
     823     
     824!     Initialisation
     825      FL=KEEQ(RADIUS,TAIR,X1,LPPWV)
     826      FH=KEEQ(RADIUS,TAIR,X2,LPPWV)
     827     
     828!     Test Bracketed values
     829      IF (((FL.LT.0.).AND.(FH.GT.0.)).OR.((FL.GT.0.).AND.(FH.LT.0.)))
     830     &  THEN
     831         XL=X1
     832         XH=X2
     833         ANS=-9.99e99
     834         
     835         DO i=1, MAXIT
     836            XM=0.5*(XL+XH)
     837            FM=KEEQ(RADIUS,TAIR,XM,LPPWV)
     838            S=SQRT(FM*FM-FL*FH)
     839           
     840            IF (S.EQ.0.0) THEN
     841               IRFRMSA=ANS
     842               RETURN
     843            ENDIF   
     844             
     845            IF (FL.GT.FH) THEN
     846               FSIGN=1.0
     847            ELSE
     848               FSIGN=-1.0
     849            ENDIF
     850           
     851            XNEW=XM+(XM-XL)*(FSIGN*FM/S)
     852           
     853            IF (ABS(XNEW-ANS).LE.XACC) THEN
     854               IRFRMSA=ANS
     855               RETURN
     856            ENDIF   
     857           
     858            ANS=XNEW
     859            FNEW=KEEQ(RADIUS,TAIR,ANS,LPPWV)
     860           
     861            IF (FNEW.EQ.0.0) THEN
     862               IRFRMSA=ANS
     863               RETURN
     864            ENDIF
     865           
     866            IF (SIGN(FM, FNEW).NE.FM) THEN
     867               XL=XM
     868               FL=FM
     869               XH=ANS
     870               FH=FNEW
     871               ELSEIF (SIGN(FL, FNEW).NE.FL) THEN
     872                  XH=ANS
     873                  FH=FNEW
     874               ELSEIF (SIGN(FH, FNEW).NE.FH) THEN
     875                  XL=ANS
     876                  FL=FNEW
     877               ELSE
     878                  PRINT*,'PROBLEM IRFRMSA dans new_cloud_venus'
     879                  PRINT*,'you shall not PAAAAAASS'
     880                  STOP
     881            ENDIF
     882         ENDDO
     883         PRINT*,'Paaaaas bien MAXIT atteint'
     884         PRINT*,'PROBLEM IRFRMSA dans new_cloud_venus'
     885         PRINT*,'you shall not PAAAAAASS'
     886         XL=X1
     887         XH=X2
     888         PRINT*,'Borne XL',XL,'XH',XH
     889         ANS=-9.99e99
     890         
     891         DO i=1, MAXIT
     892            XM=0.5*(XL+XH)
     893            FM=KEEQ(RADIUS,TAIR,XM,LPPWV)
     894            S=SQRT(FM*FM-FL*FH)
     895 
     896            IF (FL.GT.FH) THEN
     897               FSIGN=1.0
     898            ELSE
     899               FSIGN=-1.0
     900            ENDIF
     901           
     902            XNEW=XM+(XM-XL)*(FSIGN*FM/S) 
     903           
     904            ANS=XNEW
     905            FNEW=KEEQ(RADIUS,TAIR,ANS,LPPWV)
     906            PRINT*,'KEEQ result',FNEW,'T',TAIR,'R',RADIUS
     907            IF (SIGN(FM, FNEW).NE.FM) THEN
     908               XL=XM
     909               FL=FM
     910               XH=ANS
     911               FH=FNEW
     912               ELSEIF (SIGN(FL, FNEW).NE.FL) THEN
     913                  XH=ANS
     914                  FH=FNEW
     915               ELSEIF (SIGN(FH, FNEW).NE.FH) THEN
     916                  XL=ANS
     917                  FL=FNEW
     918               ELSE
     919                  PRINT*,'PROBLEM IRFRMSA dans new_cloud_venus'
     920                  PRINT*,'you shall not PAAAAAASS'
     921                  STOP
     922            ENDIF
     923         ENDDO
     924         STOP
     925      ELSE
     926         PRINT*,'IRFRMSA must be bracketed'
     927         IF (FL.EQ.0.0) THEN
     928           PRINT*,'IRFRMSA FL == 0',Fl
     929           IRFRMSA=X1
     930           RETURN
     931         ENDIF
     932         IF (FH.EQ.0.0) THEN
     933           PRINT*,'IRFRMSA FH == 0',FH
     934           IRFRMSA=X2
     935           RETURN
     936         ENDIF
     937         IF ((FL.NE.0.).AND.(FH.NE.0.)) THEN
     938           PRINT*,'IRFRMSA FH and FL neq 0: ', FL, FH
     939           PRINT*,'X1',X1,'X2',X2
     940           PRINT*,'Kind F', KIND(FL), KIND(FH)
     941           PRINT*,'Kind X', KIND(X1), KIND(X2)
     942           PRINT*,'Logical: ',(SIGN(FL,FH).NE.FL)
     943           PRINT*,'Logical: ',(SIGN(FH,FL).NE.FH)
     944           PRINT*,'nb root BRACWSA',NB
     945           STOP
     946         ENDIF   
     947     
     948      ENDIF
     949!  FIN Test Bracketed values
     950       
     951      END function IRFRMSA
     952     
     953!*****************************************************************************
     954!*     REAL FUNCTION KEEQ()                                         
     955      REAL      FUNCTION KEEQ(RADIUS,TAIR,WSA,LPPWV)
     956!*****************************************************************************
     957!* Kelvin Equation EQuality
     958!* ln(PPWV_eq) - (2Mh2o sigma)/(R T r rho) - ln(ph2osa) = 0
     959!*
     960
     961      IMPLICIT NONE
     962
     963      REAL, INTENT(IN) :: RADIUS,TAIR,WSA,LPPWV
     964
    223965!     Physical constants:
    224       REAL   MH2O, RGAS
     966      REAL   MH2O
     967      REAL   RGAS
    225968      PARAMETER(
    226969!       Molar weight of water (kg/mole)
    227970     +          MH2O=18.0153d-3,
    228971!       Universal gas constant (J/(mole K))
    229      +          RGAS=8.31441d0)
    230 !
    231 !     Mathematical constants:
    232       REAL   PI
    233       PARAMETER(PI=3.1415926536d0)
    234 
     972     +          RGAS=8.314462175d0)
    235973!
    236974!     External functions needed:
    237       REAL   PWVSAS_GV,STSAS,ROSAS
     975      REAL   PWVSAS_GV,SIGMADROPLET,RHODROPLET
    238976!     PWVSAS_GV:      Natural logaritm of water vapor pressure over
    239977!                  sulfuric acid solution
    240 !     STSAS:       Surface tension of sulfuric acid solution
    241 !     ROSAS:       Density of sulfuric acid solution
     978!     SIGMADROPLET:       Surface tension of sulfuric acid solution
     979!     RHODROPLET:       Density of sulfuric acid solution
    242980!
    243981!     Auxiliary local variables:
    244       REAL   DELW,DELLP,C1,C2,W0,W1,W2,F0,F1,WGUESS,LPPWV,RO
    245       INTEGER ITERAT,MAXITE
    246       REAL   WMIN
     982      REAL   C1
     983
    247984      PARAMETER(
    248 !         Minimum H2SO4 weight fraction:
    249      +    WMIN=0.1D0,
    250 !         Relative error on iterated weight fraction:
    251      +        DELW=0.001D0,
    252 !         Relative error on iterated ln(pressure):
    253      +        DELLP=0.0001D0,
    254 !         Guess of sulfuric acid mass fraction:
    255      +        WGUESS=0.7D0,
    256 !         Maximum iteration number:
    257      +        MAXITE=20)
    258 
    259 !
    260       PARAMETER(
    261      +        C1=2.0d0*MH2O/RGAS,
    262      +        C2=4.0d0*PI/3.0d0)
    263 !
    264 
    265 !----------------------------------------------------------------------------
    266 !      write(*,*) 'in wgtgv, tair, radius, ppwv ',
    267 !     + tair, radius, ppwv
    268 
    269       W0=WGUESS
    270       LPPWV=DLOG(PPWV)
    271 !      write(*,*) lppwv
    272       RO=ROSAS(TAIR,W0)
    273       F0=LPPWV-C1*STSAS(TAIR,W0)/(TAIR*RADIUS*RO)-PWVSAS_GV(TAIR,W0)
    274 !      write(*,*) 'st pwvsas_gv ', STSAS(TAIR,W0), PWVSAS_GV(TAIR,W0)
    275 !      write(*,*) 'F0, RO ', F0, RO
    276       W1=W0*1.01D0
    277       ITERAT=0
    278 !----------------------------------------------------------------------------
    279 10    RO=ROSAS(TAIR,W1)
    280       F1=LPPWV-C1*STSAS(TAIR,W1)/(TAIR*RADIUS*RO)-PWVSAS_GV(TAIR,W1)
    281 !      write(*,*) 'st pwvsas_gv ', STSAS(TAIR,W1), PWVSAS_GV(TAIR,W1)
    282 !      write(*,*) 'F1, RO ', F1, RO
    283       IF(ABS(F1-F0).LT.DELLP) THEN
    284           WSAS=W1
    285 !          write(*,*) 'wsas1 in wgtgv ', WSAS
    286           RHOSAS=RO
    287           MSA=C2*WSAS*RHOSAS*RADIUS**3
    288       ELSE
    289           W2=MAX(0.0D0,MIN((F1*W0-F0*W1)/(F1-F0),1.0D0))
    290 !          write(*,*) 'w2 max ', w2
    291           ITERAT=ITERAT+1
    292           IF(ABS(W2-W1).LT.DELW*ABS(W2).OR.ABS(F1).LT.DELLP.OR.
    293      +             ITERAT.GT.MAXITE) THEN
    294               WSAS=W2
    295 !              write(*,*) 'wsas2 in wgtgv ', WSAS
    296               RHOSAS=RO
    297               MSA=C2*WSAS*RHOSAS*RADIUS**3
    298           ELSE
    299               W0=W1
    300               W1=W2
    301 !              write(*,*) 'w0, w1, endloop wgtgv ', W0, W1
    302               F0=F1
    303               GOTO 10
    304           ENDIF
    305       ENDIF
    306       IF(WSAS.LT.WMIN) THEN
    307           WSAS=WMIN
    308           RHOSAS=ROSAS(TAIR,WMIN)
    309       ENDIF
    310 
    311       if(wsas .eq. 1.0) then
    312          wsas=0.999999d0
    313       endif
    314 
    315 
    316 !----------------------------------------------------------------------------
    317       RETURN
    318       END
    319 
    320 
    321 !*****************************************************************************
    322 !*     REAL FUNCTION ROSAS(TAIR,WSA)                                         
    323       REAL      FUNCTION ROSAS(TAIR,WSA)
    324 !*****************************************************************************
    325 !*
    326 !*     Density of liquid sulfuric acid solution.
    327 !*
    328 !*     Source: John H.Perry (ed.):Chemical Engineers Handbook,
    329 !*                                McGraw-Hill, New York 1963, p. 3-79 & 3-80
    330 !*
    331 !*     The original data set in temp. range 0 ! to 20 ! and weight pct.
    332 !*     0 to 100 % has been fitted with a polynomium of two variables
    333 !*     of order 5 in W and lineary in T. Fit quality better than 0.5 %
    334 !*
    335 !*     Input:  TAIR: Temperature  (K)
    336 !*             WSA:  Weight fraction of H2SO4  [0;1]
    337 !*     Output: Density of sulfuric acid solution  (kg/m**3)
    338 !*
    339 !
    340 !      USE real16
    341       IMPLICIT NONE
    342 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    343 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    344 !     + (1.0_sp_k))
    345 
    346       INTEGER I
    347       REAL   TAIR,WSA
    348       REAL, DIMENSION(6) :: C
    349       REAL, DIMENSION(6) :: A
    350       REAL, DIMENSION(6) :: B
    351       REAL, DIMENSION(6) :: D
    352       DATA (A(I),I=1,6)/
    353      # 1.00190D+03, 5.50496D+02, 1.54093D+03,-4.89219D+03, 7.56555D+03,
    354      #-3.92739D+03/
    355       DATA (B(I),I=1,6)/
    356      # 1.98378D+01, 1.02256D+03,-1.48665D+03,-7.24651D+02, 3.68348D+03,
    357      #-2.22159D+03/
    358       DATA (D(I),I=1,6)/
    359      #-6.97011E-02,-3.59886D+00, 5.24992D+00, 2.54047D+00,-1.29355D+01,
    360      # 7.80553D+00/
    361 !C
    362       DO I=1,6
    363               C(I)=A(I)+B(I)+D(I)*TAIR
    364       ENDDO
    365 
    366       ROSAS=C(1)+WSA*(C(2)+WSA*(C(3)+WSA*(C(4)+WSA*(C(5)+WSA*C(6)))))
    367      
    368       RETURN
    369       END function rosas
    370 
    371 *****************************************************************************
    372 *     REAL FUNCTION STSAS(TAIR,WSA)                                         *
    373 !    REAL FUNCTION STSAS(TAIR,WSA)
    374 *****************************************************************************
    375 *
    376 *     Surface tension of sulfuric acid solution/vapor.
    377 *
    378 *     Source: Tabazadeh et al. JGR, 102,23845,1997
    379 *             Sabinina & Terpugov: Z. Phys. Chem. A173 ,237, 1935.
    380 *
    381 *
    382 *     Input:  TAIR: Temperature (K)
    383 *             WSA:  Weight fraction of H2SO4  [0;1]
    384 *     Output: Surface tension of sulfuric acid solution (N/m)
    385 *
    386 !    IMPLICIT NONE
    387 !    REAL(KIND=4)  TAIR,WSA,W
    388 !    W=WSA*100.0d0
    389 !    STSAS=1.0d-3*(142.35d0-0.96525d0*W-TAIR*(0.22954d0-0.0033948d0*W))
    390 !    RETURN
    391 !    END
    392 *****************************************************************************
    393 *     REAL FUNCTION STSAS(TAIR,WSA)                                         *
    394       REAL     FUNCTION STSAS(TAIR,WSA)
    395 *****************************************************************************
    396 *
    397 *     Surface tension of sulfuric acid solution/vapor.
    398 *
    399 *     Source: Tabazadeh et al. submitted,1999
    400 *             Myhre et al., J. Chem. Eng. Data 43,617,1998.
    401 *
    402 *
    403 *     Input:  TAIR: Temperature (K)
    404 *             WSA:  Weight fraction of H2SO4  [0;1]
    405 *     Output: Surface tension of sulfuric acid solution (N/m)
    406 *
    407 !      USE real16
    408       IMPLICIT NONE
    409 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    410 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    411 !     + (1.0_sp_k))
    412 
    413       REAL   TAIR,WSA,W,T,S180,S220,S260
    414 !
    415       W=DBLE(WSA)*100.0D0
    416       T=DBLE(TAIR)
    417       IF(W.LT.40.0D0) THEN
    418           T=DMAX1(180.0D0,DMIN1(T,260.0D0))
    419           S220=(((((8.969257061D-7*W-1.145573827D-4)*W+5.415260617D-3)
    420      +          *W-1.050692123D-1)*W+5.312072092D-1)*W+82.01197792D0)
    421           IF(T.LE.220.0D0) THEN
    422             S180=(((((1.736789787D-6*W-1.912224154D-4)*W+7.485866933D-3)
    423      +          *W-1.103647657D-1)*W+9.541966318D-2)*W+85.75507114D0)
    424 !            STSAS=REAL(1.0D-3*(S220+(5.5D0-0.025D0*T)*(S180-S220)))
    425             STSAS=1.0D-3*(S220+(5.5D0-0.025D0*T)*(S180-S220))
    426           ELSE IF(T.GT.220.0D0) THEN
    427             S260=(((((2.095358048D-7*W-2.384669516D-5)*W+8.87979880D-4)
    428      +          *W-9.682499074D-3)*W-6.9631232740D-3)*W+77.40682664D0)
    429 !            STSAS=REAL(1.0D-3*(S260+(6.5D0-0.025D0*T)*(S220-S260)))
    430             STSAS=1.0D-3*(S260+(6.5D0-0.025D0*T)*(S220-S260))
    431           ENDIF
    432       ELSE
    433 !          STSAS=1.0d-3*
    434 !     +        REAL(142.35D0-0.96525D0*W-TAIR*(0.22954D0-0.0033948D0*W))
    435           STSAS=1.0d-3*
    436      +        142.35D0-0.96525D0*W-TAIR*(0.22954D0-0.0033948D0*W)
    437       ENDIF
    438 
    439       RETURN
    440       END
     985     +        C1=2.0d0*MH2O/RGAS)
     986
     987     
     988      KEEQ=LPPWV-C1*SIGMADROPLET(WSA,TAIR)/
     989     &     (TAIR*RADIUS*RHODROPLET(WSA,TAIR))-
     990     &     PWVSAS_GV(TAIR,WSA)
     991     
     992      END FUNCTION KEEQ
     993     
    441994*****************************************************************************
    442995*     REAL FUNCTION PWVSAS_GV(TAIR,WSA)                                       
    … …  
    4661019*     External functions needed for calculation of partial molal
    4671020*     properties of pure components at 25 ! as function of W.
    468 !      USE real16
    4691021      IMPLICIT NONE
    470 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    471 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    472 !     + (1.0_sp_k))
    473 
    474       REAL  CPH2O,ALH2O,FFH2O,LH2O
     1022
     1023      REAL :: CPH2O,ALH2O,FFH2O,LH2O
    4751024*     CPH2O:  Partial molal heat capacity of sulfuric acid solution.
    4761025*     ALH2O:  Temparature derivative of CPH2O
    … …  
    4801029!
    4811030!
    482       REAL  TAIR,WSA
    483       REAL   ADOT,BDOT,CDOT,DDOT
    484       REAL   RGAS,MMHGPA
    485       REAL   K1,K2
    486       REAL   A,B,C,D,CP,L,F,ALFA
     1031      REAL, INTENT(IN) :: TAIR,WSA
     1032      REAL :: ADOT,BDOT,CDOT,DDOT
     1033      REAL :: RGAS,MMHGPA
     1034      REAL :: K1,K2
     1035      REAL :: A,B,C,D,CP,L,F,ALFA
    4871036!     Physical constants given by Gmitro & Vermeulen:
    4881037      PARAMETER(
    … …  
    5171066!
    5181067      PWVSAS_GV=A*DLOG(K1/TAIR)+B/TAIR+C+D*TAIR+MMHGPA
    519       RETURN
    520       END
     1068     
     1069      END FUNCTION PWVSAS_GV
    5211070*******************************************************************************
    5221071*     REAL FUNCTION CPH2O(W)
    … …  
    5301079*     Source: Giauque et al.: J. Amer. Chem. Soc. 82,62,1960.
    5311080*
    532 !      USE real16
    5331081      IMPLICIT NONE
    534 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    535 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    536 !     + (1.0_sp_k))
    537 
    538       INTEGER NPOINT,I
     1082
     1083      INTEGER :: NPOINT,I
    5391084      PARAMETER(NPOINT=109)
    540       REAL   W,WTAB(NPOINT),CPHTAB(NPOINT),
    541      +              Y2(NPOINT),YWORK(NPOINT),CPH
    542       LOGICAL FIRST
     1085      REAL, DIMENSION(NPOINT) :: WTAB(NPOINT),CPHTAB(NPOINT),
     1086     +              Y2(NPOINT),YWORK(NPOINT)
     1087      REAL, INTENT(IN):: W
     1088      REAL :: CPH
     1089      LOGICAL :: FIRST
    5431090      DATA (WTAB(I),I=1,NPOINT)/
    5441091     +0.00000,0.08932,0.09819,0.10792,0.11980,0.13461,0.15360,0.16525,
    … …  
    5801127      CALL SPLINT(WTAB,CPHTAB,Y2,NPOINT,W,CPH)
    5811128      CPH2O=CPH
    582       RETURN
    583       END
     1129     
     1130      END FUNCTION CPH2O
    5841131!
    5851132*******************************************************************************
    586       REAL  FUNCTION FFH2O(W)
     1133      REAL FUNCTION FFH2O(W)
    5871134*     REAL FUNCTION FFH2O(W)
    5881135*******************************************************************************
    … …  
    5941141*     Source: Giauque et al.: J. Amer. Chem. Soc. 82,62,1960.
    5951142*
    596 !      USE real16
    5971143      IMPLICIT NONE
    598 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    599 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    600 !     + (1.0_sp_k))
    601 
    602       INTEGER NPOINT,I
     1144
     1145      INTEGER :: NPOINT,I
    6031146      PARAMETER(NPOINT=110)
    604       REAL   W,WTAB(NPOINT),FFTAB(NPOINT),
    605      +              Y2(NPOINT),YWORK(NPOINT),FF
    606       LOGICAL FIRST
     1147      REAL, DIMENSION(NPOINT) :: WTAB,FFTAB,Y2,YWORK
     1148      REAL, INTENT(IN) :: W
     1149      REAL :: FF
     1150      LOGICAL :: FIRST
    6071151      DATA (WTAB(I),I=1,NPOINT)/
    6081152     +0.00000,0.08932,0.09819,0.10792,0.11980,0.13461,0.15360,0.16525,
    … …  
    6441188      CALL SPLINT(WTAB,FFTAB,Y2,NPOINT,W,FF)
    6451189      FFH2O=FF
    646       RETURN
    647       END
     1190     
     1191      END FUNCTION FFH2O
    6481192!
    6491193*******************************************************************************
    … …  
    6581202*     Source: Giauque et al.: J. Amer. Chem. Soc. 82,62,1960.
    6591203*
    660 !      USE real16
    6611204      IMPLICIT NONE
    662 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    663 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    664 !     + (1.0_sp_k))
    665 
    666       INTEGER NPOINT,I
     1205
     1206      INTEGER :: NPOINT,I
    6671207      PARAMETER(NPOINT=110)
    668       REAL   W,WTAB(NPOINT),LTAB(NPOINT),
    669      +              Y2(NPOINT),YWORK(NPOINT),L
    670       LOGICAL FIRST
     1208      REAL, DIMENSION(NPOINT) ::  WTAB,LTAB,Y2,YWORK
     1209      REAL, INTENT(IN) :: W
     1210      REAL :: L
     1211      LOGICAL :: FIRST
    6711212      DATA (WTAB(I),I=1,NPOINT)/
    6721213     +0.00000,0.08932,0.09819,0.10792,0.11980,0.13461,0.15360,0.16525,
    … …  
    7081249      CALL SPLINT(WTAB,LTAB,Y2,NPOINT,W,L)
    7091250      LH2O=L
    710       RETURN
    711       END
     1251     
     1252      END FUNCTION LH2O
    7121253*******************************************************************************
    7131254      REAL FUNCTION ALH2O(W)
    … …  
    7211262*     Source: Giauque et al.: J. Amer. Chem. Soc. 82,62,1960.
    7221263*
    723 !      USE real16
    7241264      IMPLICIT NONE
    725 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    726 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    727 !     + (1.0_sp_k))
    728 
    729       INTEGER NPOINT,I
     1265
     1266      INTEGER :: NPOINT,I
    7301267      PARAMETER(NPOINT=96)
    731       REAL   W,WTAB(NPOINT),ATAB(NPOINT),
    732      +              Y2(NPOINT),YWORK(NPOINT),A
    733       LOGICAL FIRST
     1268      REAL, DIMENSION(NPOINT) :: WTAB,ATAB,Y2,YWORK
     1269      REAL, INTENT(IN) :: W
     1270      REAL :: A
     1271      LOGICAL :: FIRST
    7341272      DATA (WTAB(I),I=1,NPOINT)/
    7351273     +0.29517,0.31209,
    … …  
    7681306      CALL SPLINT(WTAB,ATAB,Y2,NPOINT,MAX(WTAB(1),W),A)
    7691307      ALH2O=A
    770       RETURN
    771       END
     1308     
     1309      END FUNCTION ALH2O
    7721310!******************************************************************************
    7731311      SUBROUTINE SPLINE(X,Y,N,WORK,Y2)
    … …  
    7761314!     Y(i)=Y(Xi), to be used for cubic spline calculation.
    7771315!
    778 !      USE real16
    7791316      IMPLICIT NONE
    780 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    781 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    782 !     + (1.0_sp_k))
    783 
    784       INTEGER N,I
    785       REAL   X(N),Y(N),WORK(N),Y2(N)
     1317
     1318      INTEGER, INTENT(IN) :: N
     1319      INTEGER :: I
     1320      REAL, DIMENSION(N), INTENT(IN) :: X,Y
     1321      REAL, DIMENSION(N), INTENT(OUT) :: Y2,WORK
    7861322      REAL   SIG,P,QN,UN,YP1,YPN
    7871323
    … …  
    8191355      ENDDO
    8201356!
    821       RETURN
    822       END
     1357      END SUBROUTINE SPLINE
    8231358
    8241359!******************************************************************************
    … …  
    8261361!******************************************************************************
    8271362!     Cubic spline calculation
    828 !
    829 !      USE real16
     1363
    8301364      IMPLICIT NONE
    831 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    832 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    833 !     + (1.0_sp_k))
    834 
    835       INTEGER KLO,KHI,N,K
    836       REAL   XA(N),YA(N),Y2A(N)
    837       REAL   X,Y,H,A,B
     1365
     1366      INTEGER, INTENT(IN) :: N
     1367      INTEGER :: KLO,KHI,K
     1368      REAL, INTENT(IN), DIMENSION(N) :: XA,YA,Y2A
     1369      REAL, INTENT(IN) :: X
     1370      REAL, INTENT(OUT) :: Y
     1371      REAL :: H,A,B
    8381372!
    8391373      KLO=1
    … …  
    8541388     +        ((A**3-A)*Y2A(KLO)+(B**3-B)*Y2A(KHI))*(H**2)/6.0d0
    8551389!
    856       RETURN
    857       END
     1390
     1391      END SUBROUTINE SPLINT
    8581392!******************************************************************
    859       SUBROUTINE CALNLOG_SAT(ACTSO4,H2SO4,H2O,WFSA,DENSO4,RSTDEV,
    860      + RMEDRA,T,RNLOG,H2SO4COND,H2OCOND,
    861      + acidps,satpacid)
     1393      SUBROUTINE CALCM_SAT(H2SO4,H2O,WSA,DENSO4,
     1394     + T,H2SO4COND,H2OCOND,RMTOT)
    8621395
    8631396!     DERIVE NO (TOTAL NUMBER OF AEROSOL PARTICLES CONCENTRATION)
    8641397!     FROM TOTAL H2SO4 AND RMOD/SIGMA OF AEROSOL LOG-NORMAL
    8651398!                                       SIZE DISTRIBTUION
    866 !     ASSUMING ALL THE H2SO4 ABOVE MIXTURE SAT PRESSURE IS CONDENSED
     1399!     ASSUMING ALL THE H2SO4 ABOVE MIXTURE SAT PRESSURE modified by H2SO4 activity IS CONDENSED
    8671400!    ---------------------------------------------------------------
    8681401!     INPUT:
    869 !     ACTSO4: H2SO4 activity
    870 !     H2SO4: #/cm3 of total H2SO4
    871 !       H2O  : #/cm3 of total H2O
    872 !     WFSA: aerosol H2SO4 weight fraction (fraction)
    873 !     DENSO4: aerosol volumic mass (gr/cm3 = aerosol mass/aerosol volume)
    874 !!       for total mass, almost same result with ro=1.67 gr/cm3
     1402!     H2SO4: #/m3 of total H2SO4
     1403!       H2O  : #/m3 of total H2O
     1404!     WSA: aerosol H2SO4 weight fraction (fraction)
     1405!     DENSO4: aerosol volumic mass (kg/m3 = aerosol mass/aerosol volume)
     1406!       for total mass, almost same result with ro=1.67 gr/cm3
    8751407!     RSTDEV: standard deviation of aerosol distribution (no unit)
    876 !     RMEDRA: median radius (m)
    877 !     RMEDR : median radius converti en cm
     1408!     RADIUS: MEDIAN radius (m)
    8781409!     T: temperature (K)
    8791410!
    8801411!     OUTPUT:
    881 !     RNLOG: total number of aerosol particles (VMR)
    882 !     RNLOG is in the same units as H2SO4
    883 !     if H2SO4 is in number density (for example, molec/cm3),
    884 !          RNLOG (number of particles/cm3), etc...
     1412!     RMTOT: Total condensed "Mass" (M_tot_distrib / rho_droplet), sans dimension
     1413!            mais rho_droplet et M_tot_distrib doivent tre de meme dimension
    8851414!       H2OCOND
    8861415!       H2SO4COND
    8871416
    888 !      USE real16
     1417
     1418     
    8891419      IMPLICIT NONE
    890 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    891 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    892 !     + (1.0_sp_k))
    893 
    894 !      INTEGER NOLAT,NOLEV
    895       REAL  H2SO4, H2O, WFSA, ACTSO4
    896       REAL  H2OCOND, H2SO4COND
    897       REAL  RSTDEV, RMEDRA
    898       REAL  DENSO4,  T
    899       REAL  RNLOG,RMEDR
     1420
     1421      REAL, INTENT(IN) :: H2SO4, H2O, WSA
     1422      REAL, INTENT(IN) :: DENSO4, T
     1423      REAL, INTENT(OUT) :: H2OCOND, H2SO4COND, RMTOT
    9001424!     working variables
    901       INTEGER I,J
    902       REAL  RMH2S4,PI1,RMTOT
    903       REAL  DND2,pstand,lpar,acidps
    904       REAL  x1, satpacid
     1425      REAL :: RMH2S4
     1426      REAL :: DND2,pstand,lpar,acidps
     1427      REAL :: x1, satpacid
    9051428      REAL , DIMENSION(2):: act
    9061429!
    907 !     masse of an H2SO4 molecule (g)
    908       RMH2S4=98.078/(6.02214129e23)
    909      
    910 !     3/4*PI
    911       PI1    =3./(4.0*4.0*ATAN(1.0))
    912 
    913       RMEDR=RMEDRA*1.e2 !AM: this needs to be in cm!
    914      
    915       pstand=1.01325e5 !Pa  1 atm pressure
    916 
    917         x1=(WFSA/98.08)/(WFSA/98.08 + ((1.-WFSA)/18.0153))
     1430!     masse of an H2SO4 molecule (kg)
     1431      RMH2S4=98.078/(6.02214129E+26)
     1432     
     1433      pstand=1.01325E+5 !Pa  1 atm pressure
     1434
     1435        x1=(WSA/98.08)/(WSA/98.08 + ((1.-WSA)/18.0153))
    9181436
    9191437        call zeleznik(x1,t,act)
    … …  
    9261444        acidps = DEXP(acidps)    !Pa
    9271445
    928 !acid sat.vap.pres over mixture (flat surface):
     1446!acid sat.vap.PP over mixture (flat surface):
    9291447        satpacid=act(2)*acidps ! Pa
    9301448
    9311449!       Conversion from Pa to N.D #/m3
    932         DND2=satpacid/(1.3806488e-23*T)
     1450        DND2=satpacid/(1.3806488E-23*T)
    9331451!       Conversion from N.D #/m3 TO #/cm3
    934         DND2=DND2*1.d-6
     1452!        DND2=DND2*1.d-6
    9351453               
    936 !       H2SO4COND N.D #/cm3 condensee ssi H2SO4>H2SO4sat
     1454!       H2SO4COND N.D #/m3 condensee ssi H2SO4>H2SO4sat
    9371455        IF (H2SO4.GE.DND2) THEN
    9381456        H2SO4COND=H2SO4-DND2
    9391457!       calcul de H2O cond correspondant a H2SO4 cond
    940         H2OCOND=H2SO4COND*98.078*(1.0-WFSA)/(18.0153*WFSA)
     1458        H2OCOND=H2SO4COND*98.078*(1.0-WSA)/(18.0153*WSA)
    9411459
    9421460!     RMTOT: = Mass of H2SO4 satur per cm3 of air/ Mass of sulfuric acid part of droplet solution per cm3
    9431461!       RMTOT=M_distrib/rho_droplet
    9441462       
    945         RMTOT=H2SO4COND*RMH2S4/(DENSO4*WFSA)
    946 
    947 !
    948 !       RNLOG: total number of aerosol particles per cm3
    949         RNLOG= RMTOT*EXP(-4.5*DLOG(RSTDEV)*DLOG(RSTDEV))
    950      +    *PI1/( RMEDR*RMEDR*RMEDR)
     1463        RMTOT=H2SO4COND*RMH2S4/(DENSO4*WSA)
    9511464
    9521465!       Si on a H2SO4<H2SO4sat on ne condense rien et NDTOT=0
    9531466        ELSE
    954         H2SO4COND=0.0d0
    955         H2OCOND=0.0d0
    956         RNLOG=0.0d0
     1467        H2SO4COND=0.0E+0
     1468        H2OCOND=0.0E+0
     1469        RMTOT=0.0E+0
    9571470        END IF
    9581471               
    9591472!       Test si H2O en defaut H2Ocond>H2O dispo
    960         IF (H2OCOND.GT.H2O) THEN
     1473        IF ((H2OCOND.GT.H2O).AND.(H2SO4.GE.DND2)) THEN
     1474
     1475!     Si H2O en dŽfaut, on as pas le bon WSA!
     1476!     En effet, normalement, on a exactement le WSA correspondant a
     1477!     WVg + WVl = WVtot
     1478!     Dans les cas o WVtot, SAtot sont trs faibles (Upper Haze) ou
     1479!     quand T est grand (Lower Haze), le modle reprŽsente mal le WSA
     1480!     cf carte NCL, avec des max erreur absolue de 0.1 sur le WSA
     1481
     1482!      PRINT*,'PROBLEM H2O EN DEFAUT'
     1483!      PRINT*,'H2OCOND',H2OCOND,'H2O',H2O
     1484!      PRINT*,'WSA',WSA,'RHO',DENSO4
     1485!      STOP
     1486     
    9611487       
    9621488!       On peut alors condenser tout le H2O dispo
    9631489        H2OCOND=H2O
    9641490!       On met alors egalement a jour le H2SO4 cond correspondant au H2O cond
    965         H2SO4COND=H2OCOND*18.0153*WFSA/(98.078*(1.0-WFSA))
     1491        H2SO4COND=H2OCOND*18.0153*WSA/(98.078*(1.0-WSA))
    9661492       
    9671493!     RMTOT: = Mass of H2SO4 satur per cm3 of air/ Mass of sulfuric acid part of droplet solution per cm3
    … …  
    9691495!       Volume of aerosol/cm3 air
    9701496       
    971         RMTOT=H2SO4COND*RMH2S4/(DENSO4*WFSA)
    972 
    973 !
    974 !       RNLOG: total number of aerosol particles per cm3
    975         RNLOG= RMTOT*EXP(-4.5*DLOG(RSTDEV)*DLOG(RSTDEV))
    976      +    *PI1/( RMEDR*RMEDR*RMEDR)
    977      
     1497        RMTOT=H2SO4COND*RMH2S4/(DENSO4*WSA)
     1498     
    9781499      END IF
    979        
    980 
    981                
    982       RETURN
    983       END
    984      
    985 !****************************************************************
    986       SUBROUTINE STRAACT(R2SO4,ACTSO4)
    987 
    988 !     H2SO4 ACTIVITY (GIAUQUE) AS A FUNCTION OF H2SO4 WP
    989 !    ----------------------------------------
    990 !     INPUT:
    991 !       R2SO4: percent (%) of WSA (Weight fraction of Sulfuric Acid)
    992 !
    993 !     OUTPUT:
    994 !     ACTSO4: H2SO4 activity (percent)
    995 !       USE real16
    996        IMPLICIT NONE
    997 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    998 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    999 !     + (1.0_sp_k))
    1000 
    1001            
    1002 !       INTEGER NOLAT,NOLEV
    1003        REAL  R2SO4,     ACTSO4
    1004          
    1005 !      Working variables                   
    1006        INTEGER NN,I,J,JX,JX1
    1007        REAL  TC,TB,TA,XT
    1008        PARAMETER (NN=109)
    1009        REAL, DIMENSION(NN) :: XC, X
    1010 
    1011 !      H2SO4 activity
    1012        DATA X/
    1013      *   0.0,0.25,0.78,1.437,2.19,3.07,4.03,5.04,6.08
    1014      *  ,7.13,8.18,14.33,18.59,28.59,39.17,49.49
    1015      *  ,102.4,157.8,215.7,276.9,341.6,409.8,481.5,556.6
    1016      *  ,635.5,719.,808.,902.,1000.,1103.,1211.,1322.,1437.,1555.
    1017      *  ,1677.,1800.,1926.,2054.,2183.,2312.,2442.,2572.,2701.,2829.
    1018      *  ,2955.,3080.,3203.,3325.,3446.,3564.,3681.,3796.,3910.,4022.
    1019      *  ,4134.,4351.,4564.,4771.,4974.,5171.,5364.,5551.,5732.,5908.
    1020      *  ,6079.,6244.,6404.,6559.,6709.,6854.,6994.,7131.,7264.,7393.
    1021      *  ,7520.,7821.,8105.,8373.,8627.,8867.,9093.,9308.,9511.,9703.
    1022      *  ,9885.,10060.,10225.,10535.,10819.,11079.,11318.,11537.
    1023      *  ,11740.,12097.,12407.,12676.,12915.,13126.,13564.,13910.
    1024      *  ,14191.,14423.,14617.,14786.,10568.,15299.,15491.,15654.
    1025      *  ,15811./
    1026 !      H2SO4 weight fraction (percent)
    1027        DATA XC/
    1028      *   100.0,99.982,99.963,99.945,99.927,99.908,99.890,99.872
    1029      *  ,99.853,99.835,99.817,99.725,99.634,99.452,99.270
    1030      *  ,99.090,98.196,97.319,96.457,95.610,94.777,93.959,93.156
    1031      *  ,92.365,91.588,90.824,90.073,89.334,88.607,87.892,87.188
    1032      *  ,86.495,85.814,85.143,84.482,83.832,83.191,82.560,81.939
    1033      *  ,81.327,80.724,80.130,79.545,78.968,78.399,77.839,77.286
    1034      *  ,76.741,76.204,75.675,75.152,74.637,74.129,73.628,73.133
    1035      *  ,72.164,71.220,70.300,69.404,68.530,67.678,66.847,66.037
    1036      *  ,65.245,64.472,63.718,62.981,62.261,61.557,60.868,60.195
    1037      *  ,59.537,58.893,58.263,57.646,56.159,54.747,53.405,52.126
    1038      *  ,50.908,49.745,48.634,47.572,46.555,45.580,44.646,43.749
    1039      *  ,42.059,40.495,39.043,37.691,36.430,35.251,33.107,31.209
    1040      *  ,29.517,27.999,26.629,23.728,21.397,19.482,17.882,16.525
    1041      *  ,15.360,13.461,11.980,10.792,9.819,8.932/
    1042 
    1043 
    1044 !     HERE LINEAR INTERPOLATIONS
    1045         XT=R2SO4
    1046         CALL POSACT(XT,XC,NN,JX)
    1047         JX1=JX+1
    1048         IF(JX.EQ.0) THEN
    1049           ACTSO4=0.0
    1050         ELSE IF(JX.GE.NN) THEN
    1051           ACTSO4=15811.0
    1052         ELSE
    1053           TC=XT-XC(JX)
    1054           TB=X(JX1)-X(JX)
    1055           TA=XC(JX1)-XC(JX)
    1056           TA=TB/TA
    1057           ACTSO4=X(JX)+(TA*TC)
    1058         ENDIF
    1059 10    CONTINUE
    1060 
    1061       RETURN
    1062       END
    1063 !********************************************************************
    1064        SUBROUTINE POSACT(XT,X_ARR,N,JX)
    1065            
    1066 !      POSITION OF XT IN THE ARRAY X
    1067 !    ---------------------------------------------
    1068 !       USE real16
    1069        IMPLICIT NONE
    1070 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    1071 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    1072 !     + (1.0_sp_k))
    1073 
    1074        INTEGER N
    1075        REAL  XT
    1076        REAL, DIMENSION(N) :: X_ARR
    1077 !      Working variables                   
    1078        INTEGER JX,I
    1079            
    1080        IF(XT.GT.X_ARR(1)) THEN
    1081          JX=0
    1082        ELSE
    1083          DO 10 I=1,N
    1084            IF (XT.GT.X_ARR(I)) GO TO 20
    1085  10      CONTINUE
    1086  20      JX=I
    1087        ENDIF
    1088            
    1089        RETURN
    1090        END
     1500               
     1501      END SUBROUTINE CALCM_SAT
    10911502
    10921503       SUBROUTINE Zeleznik(x,T,act)
    … …  
    10981509  !     of the aqueous sulfuric acid system to 220K-350K,
    10991510  !     mole fraction 0,...,1
    1100   !     J. Phys. Chem. Ref. Data, Vol. 20, No. 6,pp.1157, 1991
     1511  !     J. Phys. Chem. Ref. Data, Vol. 20, No. 6,PP.1157, 1991
    11011512  !+++++++++++++++++++++++++++++++++++++++++++++++++++
    11021513
    1103 !         USE real16
    11041514         IMPLICIT NONE
    1105 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    1106 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    1107 !     + (1.0_sp_k))
    1108 
    1109          REAL  x,T, activitya, activityw
    1110          REAL , DIMENSION(2):: act
     1515
     1516         REAL, INTENT(IN) :: x,T
     1517         REAL :: activitya, activityw
     1518         REAL, INTENT(OUT), DIMENSION(2):: act
    11111519!         REAL x,T, activitya, activityw
    11121520!         REAL, DIMENSION(2):: act
    … …  
    11241532!start of functions related to zeleznik activities
    11251533
    1126        FUNCTION m111(T)
    1127 !       USE real16       
    1128 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    1129 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    1130 !     + (1.0_sp_k))
    1131 
    1132        REAL  T,m111
     1534      REAL FUNCTION m111(T)
     1535
     1536       REAL, INTENT(IN) :: T
    11331537       m111=-23.524503387D0
    11341538     &    +0.0406889449841D0*T
    … …  
    11371541       END FUNCTION m111
    11381542
    1139        FUNCTION m121(T)
    1140 !       USE real16
    1141 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    1142 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    1143 !     + (1.0_sp_k))
    1144 
    1145        REAL  m121,T
     1543      REAL FUNCTION m121(T)
     1544
     1545       REAL, INTENT(IN) :: T
    11461546       m121=1114.58541077D0-1.1833078936D0*T
    11471547     &    -0.00209946114412D0*T**2-246749.842271D0/T
    … …  
    11501550
    11511551       FUNCTION m221(T)
    1152 !       USE real16
    1153 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    1154 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    1155 !     + (1.0_sp_k))
    1156 
    1157        REAL  m221,T
     1552
     1553       REAL, INTENT(IN) :: T
    11581554       m221=-80.1488100747D0-0.0116246143257D0*T
    11591555     &    +0.606767928954D-5*T**2+3092.72150882D0/T
    … …  
    11611557       END FUNCTION m221
    11621558
    1163        FUNCTION m122(T)
    1164 !       USE real16
    1165 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    1166 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    1167 !     + (1.0_sp_k))
    1168 
    1169        REAL  m122,T
     1559      REAL FUNCTION m122(T)
     1560
     1561       REAL, INTENT(IN) :: T
    11701562       m122=888.711613784D0-2.50531359687D0*T
    11711563     &    +0.000605638824061D0*T**2-196985.296431D0/T
    … …  
    11731565       END FUNCTION m122
    11741566
    1175        FUNCTION e111(T)
    1176 !       USE real16
    1177 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    1178 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    1179 !     + (1.0_sp_k))
    1180 
    1181        REAL  e111,T
     1567      REAL FUNCTION e111(T)
     1568
     1569       REAL, INTENT(IN) :: T
    11821570       e111=2887.31663295D0-3.32602457749D0*T
    11831571     &    -0.2820472833D-2*T**2-528216.112353D0/T
    … …  
    11851573       END FUNCTION e111
    11861574
    1187        FUNCTION e121(T)
    1188 !       USE real16
    1189 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    1190 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    1191 !     + (1.0_sp_k))
    1192 
    1193        REAL  e121,T
     1575      REAL FUNCTION e121(T)
     1576
     1577       REAL, INTENT(IN) :: T
    11941578       e121=-370.944593249D0-0.690310834523D0*T
    11951579     &    +0.56345508422D-3*T**2-3822.52997064D0/T
    … …  
    11971581       END FUNCTION e121
    11981582
    1199        FUNCTION e211(T)
    1200 !       USE real16
    1201 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    1202 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    1203 !     + (1.0_sp_k))
    1204 
    1205        REAL  e211,T
     1583      REAL FUNCTION e211(T)
     1584
     1585       REAL, INTENT(IN) :: T
    12061586       e211=38.3025318809D0-0.0295997878789D0*T
    12071587     &    +0.120999746782D-4*T**2-3246.97498999D0/T
    … …  
    12091589       END FUNCTION e211
    12101590
    1211        FUNCTION e221(T)
    1212 !       USE real16
    1213 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    1214 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    1215 !     + (1.0_sp_k))
    1216 
    1217        REAL  e221,T
     1591      REAL FUNCTION e221(T)
     1592
     1593       REAL, INTENT(IN) :: T
    12181594       e221=2324.76399402D0-0.141626921317D0*T
    12191595     &    -0.00626760562881D0*T**2-450590.687961D0/T
    … …  
    12211597       END FUNCTION e221
    12221598
    1223        FUNCTION e122(T)
    1224 !       USE real16
    1225 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    1226 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    1227 !     + (1.0_sp_k))
    1228 
    1229        REAL  e122,T
     1599      REAL FUNCTION e122(T)
     1600
     1601       REAL, INTENT(IN) :: T
    12301602       e122=-1633.85547832D0-3.35344369968D0*T
    12311603     &    +0.00710978119903D0*T**2+198200.003569D0/T
    … …  
    12331605       END FUNCTION e122
    12341606
    1235        FUNCTION e212(T)
    1236 !       USE real16
    1237 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    1238 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    1239 !     + (1.0_sp_k))
    1240 
    1241        REAL  e212,T
     1607      REAL FUNCTION e212(T)
     1608
     1609       REAL, INTENT(IN) :: T
    12421610       e212=1273.75159848D0+1.03333898148D0*T
    12431611     &    +0.00341400487633D0*T**2+195290.667051D0/T
    … …  
    12451613       END FUNCTION e212
    12461614
    1247        FUNCTION lnAa(x1,T)
    1248 !       USE real16
    1249 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    1250 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    1251 !     + (1.0_sp_k))
    1252 
    1253        REAL  lnAa,T,x1
    1254      &          ,m111,m121,m221,m122
     1615      REAL FUNCTION lnAa(x1,T)
     1616
     1617       REAL, INTENT(IN) :: T,x1
     1618       REAL ::
     1619     &          m111,m121,m221,m122
    12551620     &            ,e111,e121,e211,e122,e212,e221
    12561621       lnAa=-(
    … …  
    12721637       END FUNCTION lnAa
    12731638
    1274        FUNCTION lnAw(x1,T)
    1275 !       USE real16
    1276 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    1277 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    1278 !     + (1.0_sp_k))
    1279 
    1280        REAL  lnAw,T,x1
    1281      &          ,m111,m121,m221,m122
     1639      REAL FUNCTION lnAw(x1,T)
     1640
     1641       REAL, INTENT(IN) :: T,x1
     1642       REAL ::
     1643     &          m111,m121,m221,m122
    12821644     &            ,e111,e121,e211,e122,e212,e221
    12831645       lnAw=-(
    … …  
    12961658       END FUNCTION lnAw
    12971659
    1298        FUNCTION activitya(xal,T)
    1299 !       USE real16
    1300 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    1301 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    1302 !     + (1.0_sp_k))
    1303 
    1304        REAL  lnAa,T,xal,activitya
     1660      REAL FUNCTION activitya(xal,T)
     1661
     1662       REAL, INTENT(IN) :: T,xal
     1663       REAL :: lnAa
    13051664!       &          ,m111,m121,m221,m122 &
    13061665!       &            ,e111,e121,e211,e122,e212,e221
    … …  
    13111670
    13121671       FUNCTION activityw(xal,T)
    1313 !       USE real16
    1314 !      integer, parameter :: sp_k = kind(1.0) ! Default Type of REAL
    1315 !      integer, parameter :: real_8 = selected_real_kind(2*precision
    1316 !     + (1.0_sp_k))
    1317 
    1318        REAL  lnAw,T,xal,activityw
    1319 !       &          ,m111,m121,m221,m122 &
    1320 !       &            ,e111,e121,e211,e122,e212,e221
     1672
     1673       REAL, INTENT(IN) :: T,xal
     1674       REAL :: lnAw
     1675
    13211676       activityw=DEXP(lnAw(xal,T)-lnAw(1.D-12,T))
    13221677       END FUNCTION activityw
    13231678
    13241679! end of functions related to zeleznik activities
     1680
     1681
     1682
     1683
     1684      FUNCTION SIGMADROPLET(xmass,t)
     1685! calculates the surface tension of the liquid in J/m^2
     1686! xmass=mass fraction of h2so4, t in kelvins
     1687! about 230-323 K , x=0,...,1
     1688!(valid down to the solid phase limit temp, which depends on molefraction)
     1689      IMPLICIT NONE
     1690      REAL :: SIGMADROPLET
     1691      REAL, INTENT(IN):: xmass, t
     1692      REAL :: a, b, t1, tc, xmole
     1693      REAL, PARAMETER :: Msa=98.078
     1694      REAL, PARAMETER :: Mwv=18.0153
     1695
     1696       IF (t .LT. 305.15) THEN
     1697!low temperature surface tension
     1698! Hanna Vehkam‰ki and Markku Kulmala and Ismo Napari
     1699! and Kari E. J. Lehtinen and Claudia Timmreck and Madis Noppel and Ari Laaksonen, 2002,
     1700! An improved parameterization for sulfuric acid/water nucleation rates for tropospheric
     1701!and stratospheric conditions, () J. Geophys. Res., 107, pp. 4622-4631
     1702      a=0.11864+xmass*(-0.11651+xmass*(0.76852+xmass*
     1703     & (-2.40909+xmass*(2.95434-xmass*1.25852))))
     1704      b=-0.00015709+xmass*(0.00040102+xmass*(-0.00239950+xmass*
     1705     & (0.007611235+xmass*(-0.00937386+xmass*0.00389722))))
     1706      SIGMADROPLET=a+t*b
     1707      ELSE
     1708
     1709      xmole = (xmass/Msa)*(1./((xmass/Msa)+(1.-xmass)/Mwv))
     1710! high temperature surface tension
     1711!H. Vehkam‰ki and M. Kulmala and K.E. J. lehtinen, 2003,
     1712!Modelling binary homogeneous nucleation of water-sulfuric acid vapours:
     1713! parameterisation for high temperature emissions, () Environ. Sci. Technol., 37, 3392-3398
     1714
     1715      tc= 647.15*(1.0-xmole)*(1.0-xmole)+900.0*xmole*xmole+
     1716     & 3156.186*xmole*(1-xmole) !critical temperature
     1717      t1=1.0-t/tc
     1718      a= 0.2358+xmole*(-0.529+xmole*(4.073+xmole*(-12.6707+xmole*
     1719     & (15.3552+xmole*(-6.3138)))))
     1720      b=-0.14738+xmole*(0.6253+xmole*(-5.4808+xmole*(17.2366+xmole*
     1721     & (-21.0487+xmole*(8.719)))))
     1722      SIGMADROPLET=(a+b*t1)*t1**(1.256)
     1723      END IF
     1724
     1725      RETURN
     1726      END FUNCTION SIGMADROPLET
     1727
     1728      FUNCTION RHODROPLET(xmass,t)
     1729!
     1730! calculates the density of the liquid in kg/m^3
     1731! xmass=mass fraction of h2so4, t in kelvins
     1732! Hanna Vehkam‰ki and Markku Kulmala and Ismo Napari
     1733! and Kari E. J. Lehtinen and Claudia Timmreck and Madis Noppel and Ari Laaksonen, 2002,
     1734! An improved parameterization for sulfuric acid/water nucleation rates for tropospheric
     1735!and stratospheric conditions, () J. Geophys. Res., 107, pp. 4622-4631
     1736
     1737! about 220-373 K , x=0,...,1
     1738!(valid down to the solid phase limit temp, which depends on molefraction)
     1739
     1740      IMPLICIT NONE
     1741      REAL :: RHODROPLET
     1742      REAL, INTENT(IN) :: xmass, t
     1743      REAL ::  a,b,c
     1744
     1745
     1746      a=0.7681724+xmass*(2.1847140+xmass*(7.1630022+xmass*
     1747     & (-44.31447+xmass*
     1748     & (88.75606+xmass*(-75.73729+xmass*23.43228)))))
     1749      b=1.808225e-3+xmass*(-9.294656e-3+xmass*(-0.03742148+
     1750     &  xmass*(0.2565321+xmass*(-0.5362872+xmass*
     1751     &  (0.4857736-xmass*0.1629592)))))
     1752      c=-3.478524e-6+xmass*(1.335867e-5+xmass*
     1753     & (5.195706e-5+xmass*(-3.717636e-4+xmass*
     1754     & (7.990811e-4+xmass*(-7.458060e-4+xmass*2.58139e-4)))))
     1755      RHODROPLET=a+t*(b+c*t) ! g/cm^3
     1756      RHODROPLET= RHODROPLET*1.0e3 !kg/m^3
     1757      RETURN
     1758      END FUNCTION RHODROPLET
     1759
     1760
     1761
     1762

  • trunk/LMDZ.VENUS/libf/phyvenus/new_photochemistry_venus.F90

    r1305 r1442  
    1010! USE comgeomphy
    1111 USE chemparam_mod
     12 USE infotrac
    1213     
    1314 implicit none
    … …  
    3637! matrix
    3738
    38 double precision, dimension(nesp,nesp) :: mat
     39real, dimension(nesp,nesp) :: mat
    3940integer                    :: code
    4041integer, dimension(nesp)   :: indx
    … …  
    4243! number densities
    4344
    44 double precision, dimension(nz,nesp) :: c
    45 double precision, dimension(nz,nesp) :: cold
    46 double precision, dimension(nz,nesp) :: cnew
     45real, dimension(nz,nesp) :: c
     46real, dimension(nz,nesp) :: cold
     47real, dimension(nz,nesp) :: cnew
    4748     
    4849! dates, angles
    … …  
    8081real, dimension(8*nb_reaction_4_max) :: indice_4
    8182
    82 double precision, dimension(nz,nb_phot_max) :: v_phot
    83 double precision, dimension(nz,nb_reaction_3_max) :: v_3
    84 double precision, dimension(nz,nb_reaction_4_max) :: v_4
    85 
    86 double precision, dimension(nb_reaction_4_max) :: eps_4
     83real, dimension(nz,nb_phot_max) :: v_phot
     84real, dimension(nz,nb_reaction_3_max) :: v_3
     85real, dimension(nz,nb_reaction_4_max) :: v_4
     86
     87real, dimension(nb_reaction_4_max) :: eps_4
    8788
    8889     
    … …  
    118119
    119120do iz = 1,nz
    120    conc(iz) = p(iz)/(1.38d-19*t(iz))
     121   conc(iz) = p(iz)/(1.38E-19*t(iz))
    121122   c(iz,:) = tr(iz,:)*conc(iz)
    122123   cold(iz,:) = c(iz,:)     
    … …  
    142143! vitesses de reaction
    143144                   
    144 call krates(hetero_ice,hetero_dust, nz, nesp, nj, c, conc, t, p, nb_phot_max, nb_reaction_3_max, nb_reaction_4_max, v_3, v_4, v_phot,sza_input)
     145call krates(hetero_ice,hetero_dust, nz, nesp, nj, c, conc, t, p, nb_phot_max, nb_reaction_3_max, &
     146            nb_reaction_4_max, v_3, v_4, v_phot,sza_input)
    145147
    146148!      IF (n_lon .EQ. 98) THEN
    … …  
    175177                   
    176178! first guess : remplissage de la matrice
    177       call fill_matrix(iz, dt_guess, nz, nesp, v_phot, v_3, v_4, eps_4, c,nb_phot_max, nb_reaction_3_max, nb_reaction_4_max, indice_phot, indice_3, indice_4, mat)
     179      call fill_matrix(iz, dt_guess, nz, nesp, v_phot, v_3, v_4, eps_4, c,nb_phot_max, nb_reaction_3_max, &
     180                       nb_reaction_4_max, indice_phot, indice_3, indice_4, mat)
    178181
    179182! first guess : resolution du systeme lineaire
    … …  
    183186! eliminate small values
    184187
    185       where (cnew(iz,:)/conc(iz) < 1.d-30)
     188      where (cnew(iz,:)/conc(iz) < 1.E-30)
    186189         cnew(iz,:) = 0.
    187190      end where
    … …  
    194197      curv = 2.*(ratio*cnew(iz,i_o) - (1. + ratio)*c(iz,i_o) + cold(iz,i_o)) &
    195198             /(1. + ratio)
    196              e1 = (curv/(cnew(iz,i_o) + cnew(iz,i_o3) + eps))*100.0d0
     199             e1 = (curv/(cnew(iz,i_o) + cnew(iz,i_o3) + eps))*100.0E+0
    197200     
    198201      e1 = abs(e1)
    … …  
    204207             /(1. + ratio)
    205208             e2 = (curv/(cnew(iz,i_h) + cnew(iz,i_oh) + cnew(iz,i_ho2) + &
    206              2.*cnew(iz,i_h2o2)+ eps))*100.0d0
     209             2.*cnew(iz,i_h2o2)+ eps))*100.0E+0
    207210     
    208211      e2 = abs(e2)
    … …  
    213216      curv = 2.*(ratio*cnew(iz,i_so) - (1. + ratio)*c(iz,i_so) + cold(iz,i_so)) &
    214217             /(1. + ratio)
    215              e3 = (curv/(cnew(iz,i_s) + cnew(iz,i_so) + cnew(iz,i_so2)+ eps))*100.0d0
     218             e3 = (curv/(cnew(iz,i_s) + cnew(iz,i_so) + cnew(iz,i_so2)+ eps))*100.0E+0
    216219     
    217220      e3 = abs(e3)
    … …  
    234237
    235238!     remplissage de la matrix
    236          call fill_matrix(iz, dt_corrected, nz, nesp, v_phot, v_3, v_4, eps_4, c,nb_phot_max, nb_reaction_3_max, nb_reaction_4_max, indice_phot, indice_3, indice_4, mat)
     239         call fill_matrix(iz, dt_corrected, nz, nesp, v_phot, v_3, v_4, eps_4, c,nb_phot_max, nb_reaction_3_max,  &
     240                          nb_reaction_4_max, indice_phot, indice_3, indice_4, mat)
    237241
    238242!     resolution du systeme lineaire
    … …  
    245249!     eliminate small values
    246250
    247       where (cnew(iz,:)/conc(iz) < 1.d-30)
     251      where (cnew(iz,:)/conc(iz) < 1.E-30)
    248252         cnew(iz,:) = 0.
    249253      end where
    … …  
    251255      cold(iz,:)  = c(iz,:)
    252256      c(iz,:)   = cnew(iz,:)
    253       cnew(iz,:) = 0.0d0
     257      cnew(iz,:) = 0.0E+0
    254258
    255259      time = time + dt_corrected
    256260      dt_guess = dt_corrected ! pour first-guess à la prochaine iteration
    257261
     262!      DO iesp=1, nesp
     263!      IF (c(iz,iesp)/conc(iz).GT.1.0) THEN
     264!        PRINT*,'!!!! PROBLEM CHIMIE !!!!'
     265!        PRINT*,'!!!! PROBLEM TRAC    !!!!'
     266!        DO i=1,nesp
     267!          PRINT*,tname(i),c(iz,i)/conc(iz)
     268!          PRINT*,'old' ,cold(iz,i)/conc(iz)
     269!        ENDDO
     270!        DO i=1,nb_reaction_4_max
     271!          PRINT*,'v_4',i,v_4(iz,i)
     272!        ENDDO
     273!        DO i=1,nb_reaction_3_max
     274!          PRINT*,'v_3',i,v_3(iz,i)
     275!        ENDDO
     276!        DO i=1,nb_phot_max
     277!          PRINT*,'v_phot',i,v_phot(iz,i)
     278!        ENDDO
     279!        PRINT*,'T',t(iz),'P',p(iz)
     280!        PRINT*,'niv',iz,'sza',sza_input
     281!        PRINT*,'iteration',iter
     282!        STOP
     283!      ENDIF
     284!      ENDDO
     285
     286!      DO iesp=1, nb_reaction_4_max
     287!      IF (v_4(iz,iesp).LT.0.0) THEN
     288!        PRINT*,'!!!! PROBLEM CHIMIE !!!!'
     289!        PRINT*,'!!!! PROBLEM V4     !!!!'
     290!        DO i=1,nesp
     291!          PRINT*,tname(i),c(iz,i)/conc(iz)
     292!          PRINT*,'old' ,cold(iz,i)/conc(iz)
     293!        ENDDO
     294!        DO i=1,nb_reaction_4_max
     295!          PRINT*,'v_4',i,v_4(iz,i)
     296!        ENDDO
     297!        DO i=1,nb_reaction_3_max
     298!          PRINT*,'v_3',i,v_3(iz,i)
     299!        ENDDO
     300!        DO i=1,nb_phot_max
     301!          PRINT*,'v_phot',i,v_phot(iz,i)
     302!        ENDDO
     303!        PRINT*,'T',t(iz),'P',p(iz)
     304!        PRINT*,'niv',iz,'sza',sza_input
     305!        PRINT*,'iteration',iter
     306!        STOP
     307!      ENDIF
     308!      ENDDO
     309
     310!      DO iesp=1, nb_reaction_3_max
     311!      IF (v_3(iz,iesp).LT.0.0) THEN
     312!        PRINT*,'!!!! PROBLEM CHIMIE !!!!'
     313!       PRINT*,'!!!! PROBLEM V3     !!!!'
     314!       DO i=1,nesp
     315!         PRINT*,tname(i),c(iz,i)/conc(iz)
     316!         PRINT*,'old' ,cold(iz,i)/conc(iz)
     317!       ENDDO
     318!       DO i=1,nb_reaction_4_max
     319!         PRINT*,'v_4',i,v_4(iz,i)
     320!       ENDDO
     321!       DO i=1,nb_reaction_3_max
     322!         PRINT*,'v_3',i,v_3(iz,i)
     323!       ENDDO
     324!       DO i=1,nb_phot_max
     325!         PRINT*,'v_phot',i,v_phot(iz,i)
     326!       ENDDO
     327!       PRINT*,'T',t(iz),'P',p(iz)
     328!       PRINT*,'niv',iz,'sza',sza_input
     329!       PRINT*,'iteration',iter
     330!       STOP
     331!     ENDIF
     332!     ENDDO
     333     
     334!      DO iesp=1, nb_phot_max
     335!      IF (v_phot(iz,iesp).LT.0.0) THEN
     336!        PRINT*,'!!!! PROBLEM CHIMIE !!!!'
     337!        PRINT*,'!!!! PROBLEM VPHOT  !!!!'
     338!        DO i=1,nesp
     339!          PRINT*,tname(i),c(iz,i)/conc(iz)
     340!          PRINT*,'old' ,cold(iz,i)/conc(iz)
     341!        ENDDO
     342!        DO i=1,nb_reaction_4_max
     343!          PRINT*,'v_4',i,v_4(iz,i)
     344!        ENDDO
     345!        DO i=1,nb_reaction_3_max
     346!          PRINT*,'v_3',i,v_3(iz,i)
     347!        ENDDO
     348!        DO i=1,nb_phot_max
     349!          PRINT*,'v_phot',i,v_phot(iz,i)
     350!        ENDDO
     351!        PRINT*,'T',t(iz),'P',p(iz)
     352!        PRINT*,'niv',iz,'sza',sza_input
     353!        PRINT*,'iteration',iter
     354!        STOP
     355!      ENDIF
     356!      ENDDO
     357     
    258358      end do ! while (time < ptimestep)
    259359
    260360
    261 !     Actualisation des VMR traceurs avec valeurs minimales 1d-30
    262 
    263       tr(iz,:)  = max(c(iz,:)/conc(iz),1.0d-30)
    264       
    265            
     361!     Actualisation des VMR traceurs avec valeurs minimales 1E-30
     362
     363      tr(iz,:)  = max(c(iz,:)/conc(iz),1.0E-30)
     364     
     365                       
    266366   END DO ! fin de boucle sur les niveaux
    267367   
    … …  
    289389
    290390IF(n_lon .EQ. 1) THEN
    291 !PRINT*,'On est en 1D'
     391PRINT*,'On est en 1D'
    292392!PRINT*,"DEBUT rate_save"
    293393CALL rate_save(nz,p(:),t(:),tr(:,:),nesp,v_phot(:,:),v_3(:,:),v_4(:,:))
    … …  
    331431         read(30,'(7e11.4)') (jphot(iso2,isza,iz,ij), ij = 1,nj)
    332432         do ij = 1,nj
    333             if (jphot(iso2,isza,iz,ij) == 1.d-30) then
     433            if (jphot(iso2,isza,iz,ij) == 1.E-30) then
    334434               jphot(iso2,isza,iz,ij) = 0.
    335435            end if
    … …  
    23522452
    23532453integer :: nb_phot_max
    2354 double precision, dimension(nz,nb_phot_max), INTENT(INOUT) :: v_phot
    2355 
    2356 mugaz    = 43.44d-3
    2357 avogadro = 6.022e23
     2454real, dimension(nz,nb_phot_max), INTENT(INOUT) :: v_phot
     2455
     2456mugaz    = 43.44E-3
     2457avogadro = 6.022E+23
    23582458gvenus   = 8.87
    23592459
    2360 coef = avogadro/(gvenus*mugaz)*1.d-4
     2460coef = avogadro/(gvenus*mugaz)*1.E-4
    23612461
    23622462! day/night test
    … …  
    25572657                       i001, i002
    25582658
    2559 double precision, INTENT(IN), dimension(nz,nesp) :: c
     2659real, INTENT(IN), dimension(nz,nesp) :: c
    25602660
    25612661integer :: nb_phot_max, nb_reaction_3_max, nb_reaction_4_max, nb_reaction_3, nb_reaction_4, nb_phot
    25622662
    2563 double precision, dimension(nz,nb_phot_max) :: v_phot
    2564 double precision, dimension(nz,nb_reaction_3_max) :: v_3
    2565 double precision, dimension(nz,nb_reaction_4_max) :: v_4
     2663real, dimension(nz,nb_phot_max) :: v_phot
     2664real, dimension(nz,nb_reaction_3_max) :: v_3
     2665real, dimension(nz,nb_reaction_4_max) :: v_4
    25662666
    25672667pi = acos(-1.)
    … …  
    25792679!     jpl 2003
    25802680
    2581       a001(:) = 2.5*6.0d-34*(t(:)/300.)**(-2.4)*conc(:)
     2681      a001(:) = 2.5*6.0E-34*(t(:)/300.)**(-2.4)*conc(:)
    25822682
    25832683      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    25882688!     Tsang and Hampson, J. Chem. Phys. Ref. Data, 15, 1087, 1986
    25892689
    2590 !     a002(:) = 2.5*5.2d-35*exp(900./t(:))*conc(:)
     2690!     a002(:) = 2.5*5.2E-35*exp(900./t(:))*conc(:)
    25912691
    25922692!     Campbell and Gray, Chem. Phys. Lett., 18, 607, 1973
    25932693
    2594       a002(:) = 2.5*9.46d-34*exp(485./t(:))*conc(:) ! nist expression
     2694      a002(:) = 2.5*9.46E-34*exp(485./t(:))*conc(:) ! nist expression
    25952695
    25962696      nb_reaction_3 = nb_reaction_3 + 1
    … …  
    26012701!     jpl 2003
    26022702
    2603       a003(:) = 8.0d-12*exp(-2060./t(:))
     2703      a003(:) = 8.0E-12*exp(-2060./t(:))
    26042704
    26052705      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    26142714!     jpl 2006
    26152715
    2616       b001(:) = 7.5d-11*exp(115./t(:))
     2716      b001(:) = 7.5E-11*exp(115./t(:))
    26172717
    26182718      nb_phot = nb_phot + 1
    … …  
    26232723!     jpl 2006
    26242724 
    2625       b002(:) = 1.63d-10*exp(60./t(:))
     2725      b002(:) = 1.63E-10*exp(60./t(:))
    26262726     
    26272727      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    26322732!     jpl 2003
    26332733
    2634       b003(:) = 1.1d-10
     2734      b003(:) = 1.1E-10
    26352735
    26362736      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    26412741!     jpl 2006
    26422742
    2643       b004(:) = 3.3d-11*exp(55./t(:))
     2743      b004(:) = 3.3E-11*exp(55./t(:))
    26442744
    26452745      nb_phot = nb_phot + 1
    … …  
    26502750!     jpl 2003
    26512751
    2652       b005(:) = 1.2d-10
     2752      b005(:) = 1.2E-10
    26532753
    26542754      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    26592759!     jpl 2003
    26602760
    2661       b006(:) = 1.2d-10
     2761      b006(:) = 1.2E-10
    26622762
    26632763      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    26722772!     jpl 2003
    26732773
    2674       c001(:) = 3.0d-11*exp(200./t(:))
     2774      c001(:) = 3.0E-11*exp(200./t(:))
    26752775
    26762776      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    26812781!     jpl 2003
    26822782
    2683       c002(:) = 2.2d-11*exp(120./t(:))
     2783      c002(:) = 2.2E-11*exp(120./t(:))
    26842784
    26852785      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    26902790!     jpl 2003
    26912791
    2692       c003(:) = 1.4d-10*exp(-470./t(:))
     2792      c003(:) = 1.4E-10*exp(-470./t(:))
    26932793
    26942794      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    26992799!     jpl 2006
    27002800
    2701       c004(:) = 7.2d-11
     2801      c004(:) = 7.2E-11
    27022802
    27032803      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    27082808!     jpl 2006
    27092809
    2710       c005(:) = 6.9d-12
     2810      c005(:) = 6.9E-12
    27112811
    27122812      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    27172817!     jpl 2006
    27182818
    2719       c006(:) = 1.6d-12
     2819      c006(:) = 1.6E-12
    27202820
    27212821      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    27262826!     jpl 2003
    27272827
    2728       c007(:) = 4.8d-11*exp(250./t(:))
     2828      c007(:) = 4.8E-11*exp(250./t(:))
    27292829
    27302830      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    27352835!     jpl 2006
    27362836
    2737 !     c008(:) = 3.5d-13*exp(430./t(:))
     2837!     c008(:) = 3.5E-13*exp(430./t(:))
    27382838
    27392839!     christensen et al., grl, 13, 2002
    27402840
    2741       c008(:) = 1.5d-12*exp(19./t(:))
     2841      c008(:) = 1.5E-12*exp(19./t(:))
    27422842
    27432843      nb_reaction_3 = nb_reaction_3 + 1
    … …  
    27482848!     jpl 2006
    27492849
    2750       c009(:) = 1.8d-12
     2850      c009(:) = 1.8E-12
    27512851
    27522852      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    27572857!     jpl 2006
    27582858
    2759       c010(:) = 2.8d-12*exp(-1800./t(:))
     2859      c010(:) = 2.8E-12*exp(-1800./t(:))
    27602860
    27612861      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    27672867
    27682868      do iz = 1,nz
    2769          ak0 = 2.5*4.4d-32*(t(iz)/300.)**(-1.3)
    2770          ak1 = 4.7d-11*(t(iz)/300.)**(-0.2)
     2869         ak0 = 2.5*4.4E-32*(t(iz)/300.)**(-1.3)
     2870         ak1 = 4.7E-11*(t(iz)/300.)**(-0.2)
    27712871
    27722872         rate = (ak0*conc(iz))/(1. + ak0*conc(iz)/ak1)
    … …  
    27822882!     jpl 2003
    27832883
    2784       c012(:) = 1.4d-12*exp(-2000./t(:))
     2884      c012(:) = 1.4E-12*exp(-2000./t(:))
    27852885
    27862886      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    27912891!     jpl 2006
    27922892
    2793       c013(:) = 1.8d-12
     2893      c013(:) = 1.8E-12
    27942894
    27952895      nb_reaction_3 = nb_reaction_3 + 1
    … …  
    28002900!     jpl 2003
    28012901
    2802       c014(:) = 1.7d-12*exp(-940./t(:))
     2902      c014(:) = 1.7E-12*exp(-940./t(:))
    28032903
    28042904      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    28092909!     jpl 2003
    28102910
    2811       c015(:) = 1.0d-14*exp(-490./t(:))
     2911      c015(:) = 1.0E-14*exp(-490./t(:))
    28122912
    28132913      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    28182918!     jpl 2003
    28192919
    2820       c016(:) = 2.5*1.7d-33*exp(1000./t(:))*conc(:)
     2920      c016(:) = 2.5*1.7E-33*exp(1000./t(:))*conc(:)
    28212921
    28222922      nb_reaction_3 = nb_reaction_3 + 1
    … …  
    28282928
    28292929      do iz = 1,nz
    2830          ak0 = 2.5*6.9d-31*(t(iz)/300.)**(-1.0)
    2831          ak1 = 2.6d-11*(t(iz)/300.)**(0.0)
     2930         ak0 = 2.5*6.9E-31*(t(iz)/300.)**(-1.0)
     2931         ak1 = 2.6E-11*(t(iz)/300.)**(0.0)
    28322932
    28332933         rate = (ak0*conc(iz))/(1. + ak0*conc(iz)/ak1)
    … …  
    28432943!     baulch et al., 2005
    28442944
    2845       c018(:) = 2.5*1.8d-30*(t(:)**(-1.0))*conc(:)
     2945      c018(:) = 2.5*1.8E-30*(t(:)**(-1.0))*conc(:)
    28462946
    28472947      nb_reaction_3 = nb_reaction_3 + 1
    … …  
    28562956!     jpl 2006
    28572957
    2858       d001(:) = 5.1d-12*exp(210./t(:))
     2958      d001(:) = 5.1E-12*exp(210./t(:))
    28592959
    28602960!---  d002: no + o3 -> no2 + o2
    … …  
    28622962!     jpl 2006
    28632963
    2864       d002(:) = 3.0d-12*exp(-1500./t(:))
     2964      d002(:) = 3.0E-12*exp(-1500./t(:))
    28652965
    28662966!---  d003: no + ho2 -> no2 + oh
    … …  
    28682968!     jpl 2006
    28692969
    2870       d003(:) = 3.5d-12*exp(250./t(:))
     2970      d003(:) = 3.5E-12*exp(250./t(:))
    28712971
    28722972!----------------------------------------------------------------------
    … …  
    28782978!     jpl 2003
    28792979
    2880 !     e001(:) = 1.5d-13*(1 + 0.6*p(:)/1013.)
     2980!     e001(:) = 1.5E-13*(1 + 0.6*p(:)/1013.)
    28812981
    28822982!     mccabe et al., grl, 28, 3135, 2001
    28832983
    2884 !     e001(:) = 1.57d-13 + 3.54d-33*conc(:)
     2984!     e001(:) = 1.57E-13 + 3.54E-33*conc(:)
    28852985
    28862986!     jpl 2006
    28872987
    2888 !     ak0 = 1.5d-13*(t(:)/300.)**(0.6)
    2889 !     ak1 = 2.1d-9*(t(:)/300.)**(6.1)
     2988!     ak0 = 1.5E-13*(t(:)/300.)**(0.6)
     2989!     ak1 = 2.1E-9*(t(:)/300.)**(6.1)
    28902990!     rate1 = ak0/(1. + ak0/(ak1/conc(:)))
    28912991!     xpo1 = 1./(1. + alog10(ak0/(ak1/conc(:)))**2)
    28922992
    2893 !     ak0 = 5.9d-33*(t(:)/300.)**(-1.4)
    2894 !     ak1 = 1.1d-12*(t(:)/300.)**(1.3)
     2993!     ak0 = 5.9E-33*(t(:)/300.)**(-1.4)
     2994!     ak1 = 1.1E-12*(t(:)/300.)**(1.3)
    28952995!     rate2 = (ak0*conc(:))/(1. + ak0*conc(:)/ak1)
    28962996!     xpo2 = 1./(1. + alog10((ak0*conc(:))/ak1)**2)
    … …  
    29023002      do iz = 1,nz
    29033003         k1a0 = 1.34*2.5*conc(iz)                                &
    2904                *1/(1/(3.62d-26*t(iz)**(-2.739)*exp(-20./t(iz)))  &
    2905                + 1/(6.48d-33*t(iz)**(0.14)*exp(-57./t(iz))))     ! corrige de l'erreur publi
    2906          k1b0 = 1.17d-19*t(iz)**(2.053)*exp(139./t(iz))          &
    2907               + 9.56d-12*t(iz)**(-0.664)*exp(-167./t(iz))
    2908          k1ainf = 1.52d-17*t(iz)**(1.858)*exp(28.8/t(iz))        &
    2909                 + 4.78d-8*t(iz)**(-1.851)*exp(-318./t(iz))
     3004               *1/(1/(3.62E-26*t(iz)**(-2.739)*exp(-20./t(iz)))  &
     3005               + 1/(6.48E-33*t(iz)**(0.14)*exp(-57./t(iz))))     ! corrige de l'erreur publi
     3006         k1b0 = 1.17E-19*t(iz)**(2.053)*exp(139./t(iz))          &
     3007              + 9.56E-12*t(iz)**(-0.664)*exp(-167./t(iz))
     3008         k1ainf = 1.52E-17*t(iz)**(1.858)*exp(28.8/t(iz))        &
     3009                + 4.78E-8*t(iz)**(-1.851)*exp(-318./t(iz))
    29103010         x = k1a0/(k1ainf - k1b0)
    29113011         y = k1b0/(k1ainf - k1b0)
    … …  
    29263026!     tsang and hampson, 1986.
    29273027
    2928       e002(:) = 2.5*6.5d-33*exp(-2184./t(:))*conc(:)
     3028      e002(:) = 2.5*6.5E-33*exp(-2184./t(:))*conc(:)
    29293029
    29303030      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    29393039!     jpl 2011
    29403040
    2941       f001(:) = 1.0d-10
     3041      f001(:) = 1.0E-10
    29423042
    29433043      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    29483048!     jpl 2011
    29493049
    2950       f002(:) = 3.6d-11
     3050      f002(:) = 3.6E-11
    29513051     
    29523052      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    29573057!     jpl 2006
    29583058
    2959       f003(:) = 1.0d-11*exp(-3300./t(:))
     3059      f003(:) = 1.0E-11*exp(-3300./t(:))
    29603060
    29613061      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    29663066!     jpl 2006
    29673067
    2968       f004(:) = 2.6d-12*exp(-350./t(:))
     3068      f004(:) = 2.6E-12*exp(-350./t(:))
    29693069
    29703070      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    29753075!     jpl 2006
    29763076
    2977       f005(:) = 2.8d-11*exp(85./t(:))
     3077      f005(:) = 2.8E-11*exp(85./t(:))
    29783078
    29793079      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    29843084!     jpl 2006
    29853085
    2986       f006(:) = 7.4d-12*exp(270./t(:))
     3086      f006(:) = 7.4E-12*exp(270./t(:))
    29873087
    29883088      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    29933093!     jpl 2006
    29943094
    2995       f007(:) = 6.0d-13*exp(230./t(:))
     3095      f007(:) = 6.0E-13*exp(230./t(:))
    29963096
    29973097      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    30023102!     jpl 2006
    30033103
    3004       f008(:) = 3.05d-11*exp(-2270./t(:))
     3104      f008(:) = 3.05E-11*exp(-2270./t(:))
    30053105
    30063106      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    30113111!     jpl 2006
    30123112
    3013       f009(:) = 2.3d-11*exp(-200./t(:))
     3113      f009(:) = 2.3E-11*exp(-200./t(:))
    30143114
    30153115      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    30203120!     jpl 2006
    30213121
    3022       f010(:) = 4.1d-11*exp(-450./t(:))
     3122      f010(:) = 4.1E-11*exp(-450./t(:))
    30233123
    30243124      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    30293129!     jpl 2006
    30303130
    3031       f011(:) = 1.8d-11*exp(170./t(:))
     3131      f011(:) = 1.8E-11*exp(170./t(:))
    30323132
    30333133      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    30383138!     jpl 2006
    30393139
    3040       f012(:) = 1.1d-11*exp(-980./t(:))
     3140      f012(:) = 1.1E-11*exp(-980./t(:))
    30413141
    30423142      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    30473147!     jpl 2011 + nicovich et al., j. phys. chem., 1990
    30483148
    3049       f013(:) = 3.2*1.3d-33*(t(:)/300.)**(-3.8)*conc(:)
     3149      f013(:) = 3.2*1.3E-33*(t(:)/300.)**(-3.8)*conc(:)
    30503150
    30513151      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    30563156!     jpl 2011
    30573157
    3058 !     deq(:) = 3.2*3.5d-25*exp(3730./t(:))
     3158!     deq(:) = 3.2*3.5E-25*exp(3730./t(:))
    30593159
    30603160!     mills, 1998
    30613161
    3062       deq(:) = 1.6d-25*exp(4000./t(:))
     3162      deq(:) = 1.6E-25*exp(4000./t(:))
    30633163
    30643164      f014(:) = f013(:)/(deq(:)*conc(:))
    … …  
    30763176!     yung and demore, icarus, 51, 199-247, 1982.
    30773177
    3078       f015(:) = 5.7d-15*exp(500./t(:))*conc(:)   &
     3178      f015(:) = 5.7E-15*exp(500./t(:))*conc(:)   &
    30793179               /(1.e17 + 0.05*conc(:))
    30803180
    … …  
    30903190!     0.5 clco3 + 0.5 cl -> clo + 0.5 co2
    30913191
    3092       f016(:) = 1.0d-11
     3192      f016(:) = 1.0E-11
    30933193
    30943194      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    31063206!     0.5 clco3 + 0.5 o -> o2 + co2
    31073207
    3108       f017(:) = 1.0d-11
     3208      f017(:) = 1.0E-11
    31093209
    31103210      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    31163216!---  f018: clo + ho2  -> hocl + o2
    31173217
    3118       f018(:) = 2.7d-12*exp(220./t(:))
     3218      f018(:) = 2.7E-12*exp(220./t(:))
    31193219
    31203220      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    31233223!---  f019: oh + hocl -> h2o + clo
    31243224
    3125       f019(:) = 3.0d-12*exp(-500./t(:))
     3225      f019(:) = 3.0E-12*exp(-500./t(:))
    31263226
    31273227      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    31303230!---  f020: o + hocl -> oh + clo
    31313231
    3132       f020(:) = 1.7d-13
     3232      f020(:) = 1.7E-13
    31333233
    31343234      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    31393239!     donohoue et al., j. phys. chem. a, 109, 7732-7741, 2005
    31403240
    3141 !     f021(:) = 2.5*8.4d-33*exp(850.*(1./t(:) - 1./298.))*conc(:)
     3241!     f021(:) = 2.5*8.4E-33*exp(850.*(1./t(:) - 1./298.))*conc(:)
    31423242
    31433243!     valeur utilisee par Zhang et al., 2011:
    31443244
    3145       f021(:) = 2.6d-33*exp(900./t(:))*conc(:)
     3245      f021(:) = 2.6E-33*exp(900./t(:))*conc(:)
    31463246
    31473247      nb_reaction_3 = nb_reaction_3 + 1
    … …  
    31523252!     yung et al., icarus, 1982 (estimated)
    31533253
    3154       f022(:) = 3.0d-11
     3254      f022(:) = 3.0E-11
    31553255
    31563256      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    31613261!     jpl 2011
    31623262
    3163       f023(:) = 2.0d-10
     3263      f023(:) = 2.0E-10
    31643264
    31653265      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    31703270!     baulch et al., j. phys. chem. ref. data, 1981
    31713271
    3172       f024(:) = 1.43d-10*exp(-591./t(:))
     3272      f024(:) = 1.43E-10*exp(-591./t(:))
    31733273
    31743274      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    31793279!     baulch et al., j. phys. chem. ref. data, 1981
    31803280
    3181       f025(:) = 2.16d-9*exp(-1670./t(:))
     3281      f025(:) = 2.16E-9*exp(-1670./t(:))
    31823282
    31833283      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    31883288!     zhang et al., icarus, 2011 (estimated)
    31893289
    3190       f026(:) = 5.0d-11
     3290      f026(:) = 5.0E-11
    31913291
    31923292      nb_reaction_3 = nb_reaction_3 + 1
    … …  
    31973297!     mills, phd, 1998
    31983298
    3199       f027(:) = 1.3d-34*exp(940./t(:))*conc(:)
     3299      f027(:) = 1.3E-34*exp(940./t(:))*conc(:)
    32003300
    32013301      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    32063306!     mills, phd, 1998
    32073307
    3208       f028(:) = 1.0d-11
     3308      f028(:) = 1.0E-11
    32093309
    32103310      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    32153315!     mills, phd, 1998
    32163316
    3217       f029(:) = 1.0d-11
     3317      f029(:) = 1.0E-11
    32183318
    32193319      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    32243324!     moses et al. 2002
    32253325
    3226       f030(:) = 5.0d-13
     3326      f030(:) = 5.0E-13
    32273327
    32283328      nb_reaction_3 = nb_reaction_3 + 1
    … …  
    32333333!     yung and demore, 1999 (estimated)
    32343334
    3235       f031(:) = 5.0d-32*conc(:)
     3335      f031(:) = 5.0E-32*conc(:)
    32363336
    32373337      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    32423342!     mills, phd, 1998
    32433343
    3244       f032(:) = 7.4d-12*exp(-1650./t(:))
     3344      f032(:) = 7.4E-12*exp(-1650./t(:))
    32453345
    32463346      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    32513351!     mills, phd, 1998
    32523352
    3253       f033(:) = 1.5d-10
     3353      f033(:) = 1.5E-10
    32543354
    32553355      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    32603360!     jpl 2011
    32613361
    3262       f034(:) = 2.6d-12*exp(-1100./t(:))
     3362      f034(:) = 2.6E-12*exp(-1100./t(:))
    32633363
    32643364      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    32693369!     yung and demore, 1982
    32703370
    3271       f035(:) = 3.0d-12
     3371      f035(:) = 3.0E-12
    32723372
    32733373      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    32783378!     ohta, bull. chem. soc. jpn., 1983
    32793379
    3280       f036(:) = 6.45d-2*f015(:)
     3380      f036(:) = 6.45E-2*f015(:)
    32813381
    32823382      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    32873387!     mills, phd, 1998
    32883388
    3289       f037(:) = 1.5d-11*exp(-1750./t(:))
     3389      f037(:) = 1.5E-11*exp(-1750./t(:))
    32903390
    32913391      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    32963396!     yung and demore, 1982
    32973397
    3298       f038(:) = 1.0d-11
     3398      f038(:) = 1.0E-11
    32993399
    33003400      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    33053405!     yung and demore, 1982 (estimate)
    33063406
    3307       f039(:) = 1.0d-32*conc(:)
     3407      f039(:) = 1.0E-32*conc(:)
    33083408
    33093409      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    33163416!---  g001: s + o2 -> so + o
    33173417
    3318       g001(:) = 2.3d-12
     3418      g001(:) = 2.3E-12
    33193419
    33203420      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    33233423!---  g002: s + o3 -> so + o2
    33243424
    3325       g002(:) = 1.2d-11
     3425      g002(:) = 1.2E-11
    33263426
    33273427      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    33303430!---  g003: so + o2 -> so2 + o
    33313431
    3332       g003(:) = 1.25d-13*exp(-2190./t(:))
     3432      g003(:) = 1.25E-13*exp(-2190./t(:))
    33333433
    33343434      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    33373437!---  g004: so + o3 -> so2 + o2
    33383438
    3339       g004(:) = 3.4d-12*exp(-1100./t(:))
     3439      g004(:) = 3.4E-12*exp(-1100./t(:))
    33403440
    33413441      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    33443444!---  g005: so + oh -> so2 + h
    33453445
    3346       g005(:) = 2.7d-11*exp(335./t(:))
     3446      g005(:) = 2.7E-11*exp(335./t(:))
    33473447
    33483448      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    33513451!---  g006: s + oh -> so + h
    33523452
    3353       g006(:) = 6.6d-11
     3453      g006(:) = 6.6E-11
    33543454
    33553455      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    33623462
    33633463      do iz = 1,nz
    3364          ak0 = 4.2d-30
    3365          ak1 = 5.3d-11
     3464         ak0 = 4.2E-30
     3465         ak1 = 5.3E-11
    33663466
    33673467         rate = (ak0*conc(iz))/(1. + ak0*conc(iz)/ak1)
    … …  
    33753475!---  g008: so + ho2 -> so2 + oh
    33763476
    3377       g008(:) = 2.8d-11
     3477      g008(:) = 2.8E-11
    33783478
    33793479      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    33833483
    33843484!     jpl 2011
     3485!     Naido 2005
     3486
     3487!      do iz = 1,nz
     3488!         ak0 = 2.5*1.8E-33*(t(iz)/300.)**(2.0)
     3489!         ak1 = 4.2E-14*(t(iz)/300.)**(1.8)
     3490
     3491!         rate = (ak0*conc(iz))/(1. + ak0*conc(iz)/ak1)
     3492!         xpo = 1./(1. + alog10((ak0*conc(iz))/ak1)**2)
     3493!         g009(iz) = rate*0.6**xpo
     3494!         g009(iz) = 0.0E+0
     3495!      end do
    33853496
    33863497      do iz = 1,nz
    3387          ak0 = 2.5*1.8d-33*(t(iz)/300.)**(2.0)
    3388          ak1 = 4.2d-14*(t(iz)/300.)**(1.8)
    3389 
     3498         ak0 = 5.*9.5*1.E-23*(t(iz)**(-3.0))*EXP(-2400./t(iz))
     3499         ak1 = 6.1*1.E-13*EXP(-850./t(iz))
    33903500         rate = (ak0*conc(iz))/(1. + ak0*conc(iz)/ak1)
    33913501         xpo = 1./(1. + alog10((ak0*conc(iz))/ak1)**2)
    3392          g009(iz) = rate*0.6**xpo
     3502         fc = 0.558*EXP(-t(iz)/316.)+0.442*EXP(-t(iz)/7442.)
     3503         g009(iz) = rate*fc**xpo
     3504!         g009(iz) = 0.0E+0
    33933505      end do
    33943506
    … …  
    34003512!     zhang et al., icarus, 2011
    34013513
    3402       g010(:) = 1.5d-34*exp(900./t(:))*conc(:)
     3514      g010(:) = 1.5E-34*exp(900./t(:))*conc(:)
    34033515
    34043516      nb_reaction_4 = nb_reaction_4 + 1
    34053517      v_4(:,nb_reaction_4) = g010(:)
    34063518
    3407 !---  g011: so3 + h2o -> h2so4
    3408 
     3519!---  g011: so3 + h2o + M -> h2so4 + M
     3520!---  avec M = h2o
     3521
     3522      DO iz=1,nz
    34093523!     jpl 2011
    3410 
    3411 !      g011(:) = 8.5d-21*exp(6540./t(:))*c(:,i_h2o)
    3412       g011(:) = 2.26d-23*t(:)*exp(6540/t(:))*c(:,i_h2o)
    3413       g011(:) = g011(:)*1.d-20
     3524!      g011(:) = 8.5E-21*exp(6540./t(:))*c(:,i_h2o)
     3525      g011(iz) = 2.26E-23*MAX(t(iz),100.)*exp(6540./MAX(t(iz),100.)) &
     3526                *c(iz,i_h2o)
     3527      g011(iz) = g011(iz)*1.0E-20
    34143528!      g011(:) = 0. ! SANS H2SO4
     3529      ENDDO
    34153530
    34163531      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    34213536!     jpl 2011
    34223537
    3423       g012(:) = 2.8d-11
     3538      g012(:) = 2.8E-11
    34243539
    34253540      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    34303545!     chung et al., int. j. chem. kinet., 1975
    34313546
    3432       g013(:) = 2.0d-15
     3547      g013(:) = 2.0E-15
    34333548
    34343549      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    34393554!     jacob and winkler, j. chem. soc. faraday trans. 1, 1972
    34403555
    3441       g014(:) = 2.32d-16*exp(-487./t(:))
     3556      g014(:) = 2.32E-16*exp(-487./t(:))
    34423557
    34433558      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    34493564
    34503565      do iz = 1,nz
    3451          ak0 = 2.5*4.4d-31
    3452          ak1 = 1.0d-11
     3566         ak0 = 2.5*4.4E-31
     3567         ak1 = 1.0E-11
    34533568
    34543569         rate = (ak0*conc(iz))/(1. + ak0*conc(iz)/ak1)
    … …  
    34643579!     mills, phd, 1998
    34653580
    3466       deq(:) = 2.5*1.0d-28*exp(6000./t(:))
     3581      deq(:) = 2.5*1.0E-28*exp(6000./t(:))
    34673582
    34683583      g016(:) = g015(:)/(deq(:)*conc(:))
    … …  
    34793594!     0.5 clco3 + 0.5 so -> so2 + co2
    34803595
    3481       g017(:) = 1.0d-11
     3596      g017(:) = 1.0E-11
    34823597
    34833598      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    34913606!     zhang et al., icarus, 2011 (estimate?)
    34923607
    3493       g018(:) = 2.5*4.0d-33*exp(-1940./t(:))*conc(:)
     3608      g018(:) = 2.5*4.0E-33*exp(-1940./t(:))*conc(:)
     3609     
     3610!      g018(:) = 0.0E+0
    34943611
    34953612      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    35003617!     zhang et al., icarus, 2011
    35013618
    3502       g019(:) = 3.0d-12
     3619      g019(:) = 3.0E-12
     3620
     3621!      g019(:) = 0.0E+0
    35033622
    35043623      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    35103629
    35113630      do iz = 1,nz
    3512          ak0 = 2.5*3.3d-31*(t(iz)/300.)**(-4.3)
    3513          ak1 = 1.6d-12
     3631         ak0 = 2.5*3.3E-31*(t(iz)/300.)**(-4.3)
     3632         ak1 = 1.6E-12
    35143633
    35153634         rate = (ak0*conc(iz))/(1. + ak0*conc(iz)/ak1)
    … …  
    35253644!     jpl 2011
    35263645
    3527       g021(:) = 1.3d-12*exp(-330./t(:))
     3646      g021(:) = 1.3E-12*exp(-330./t(:))
    35283647
    35293648      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    35353654
    35363655      do iz = 1,nz
    3537          ak0 = 1.19d-29
    3538          ak1 = 1.0d-10
     3656         ak0 = 1.19E-29
     3657         ak1 = 1.0E-10
    35393658
    35403659         rate = (ak0*conc(iz))/(1. + ak0*conc(iz)/ak1)
    … …  
    35503669!     chase et al., 1985
    35513670
    3552 !      deq(:) = 2.68d-25*exp(50860./t(:))
     3671!      deq(:) = 2.68E-25*exp(50860./t(:))
    35533672
    35543673!      g023(:) = g022(:)/(deq(:)*conc(:))
    … …  
    35603679!     Pas encore inclu dans la table jphot
    35613680
    3562       g023(:) = 6.5d-3
    3563      
     3681!     Pas de photodissociation sous le nuage photochimique
     3682      g023(1:28)  = 0.0E+0
     3683
     3684!     Dependance en sza pour la photodissociation
     3685!     moins de W.m-2     
     3686      IF (sza_input.LT.90.0) THEN
     3687        g023(29:50) = 6.5E-3*COS(sza_input*pi/180.0)
     3688      ELSE
     3689        g023(29:50) = 0.0E+0
     3690      END IF
     3691           
    35643692      nb_phot = nb_phot + 1
    35653693     
    3566       IF (sza_input.LE.95.0) THEN
    35673694      v_phot(:,nb_phot) = g023(:)
    3568       ELSE
    3569       v_phot(:,nb_phot) = 0.0d0
    3570       END IF
    35713695
    35723696!---  g024: s2 + o -> so + s
    … …  
    35743698!     zhang et al., icarus, 2011
    35753699
    3576       g024(:) = 2.2d-11*exp(-84./t(:))
     3700      g024(:) = 2.2E-11*exp(-84./t(:))
    35773701
    35783702      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    35833707!     lu et al., j. chem. phys., 2006
    35843708
    3585       g025(:) = 6.63d-20*(t(:)**2.57)*exp(-1180./t(:))
     3709      g025(:) = 6.63E-20*(t(:)**2.57)*exp(-1180./t(:))
     3710     
     3711!      g025(:) = 0.0E+0
    35863712
    35873713      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    35923718!     atkinson et al., 2004
    35933719
    3594       g026(:) = 1.60d-11*exp(-2150./t(:))
     3720      g026(:) = 1.60E-11*exp(-2150./t(:))
    35953721
    35963722      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    36013727!     moses et al., 2002
    36023728
    3603       g027(:) = 1.0d-16
     3729      g027(:) = 1.0E-16
    36043730
    36053731      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    36103736!     yung and demore, 1982
    36113737
    3612       g028(:) = 3.0d-11*exp(200./t(:))
     3738      g028(:) = 3.0E-11*exp(200./t(:))
    36133739
    36143740      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    36193745!     moses et al., 2002
    36203746
    3621       g029(:) = 4.0d-11
     3747      g029(:) = 4.0E-11
    36223748
    36233749      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    36283754!     krasnopolsky , 2007
    36293755
    3630       g030(:) = 7.0d-14*exp(-5170./t(:))
    3631 !      g030(:) = 0.0d0
     3756      g030(:) = 7.0E-14*exp(-5170./t(:))
     3757
     3758!      g030(:) = g011(:)/(deq(:)*c(:,i_h2o))
     3759!      g030(:) = 0.0E+0
    36323760
    36333761      nb_phot = nb_phot + 1
    36343762      v_phot(:,nb_phot) = g030(:)*c(:,i_h2o)
     3763 !     v_phot(:,nb_phot) = 0.0E+0
    36353764     
    36363765!---  g031: so3 + ocs -> s2o2 +  co2
    … …  
    36383767!     krasnopolsky , 2007
    36393768
    3640       g031(:) = 1.0d-11*exp(-10000./t(:))
    3641 !      g031(:) = 0.0d0
     3769      g031(:) = 1.0E-11*exp(-10000./t(:))
     3770!      g031(:) = 0.0E+0
    36423771     
    36433772      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    36523781!     krasnopolsky , 2007
    36533782
    3654       g032(:) = 1.0d-20
    3655 !      g032(:) = 0.0d0
     3783      g032(:) = 1.0E-20
     3784!      g032(:) = 0.0E+0
    36563785     
    36573786      nb_reaction_4 = nb_reaction_4 + 1
    … …  
    36643793!  Krasnopolsky 2012 from Martinez & Heron 1983 or Moses et al 2002
    36653794
    3666 !      g033(:) = 3.5d-15
    3667       g033(:) =1.0d-12*exp(-1700.0/t(:))
     3795!      g033(:) = 3.5E-15
     3796      g033(:) =1.0E-12*exp(-1700.0/t(:))
    36683797     
    36693798      nb_reaction_3 = nb_reaction_3 + 1
    … …  
    36843813     
    36853814         gam = 0.025
    3686          h001(:) = surfice1d(:)*1.d-8       &
    3687                    *100.*sqrt(8.*8.31*t(:)/(33.d-3*pi))*gam/4.
     3815         h001(:) = surfice1d(:)*1.E-8       &
     3816                   *100.*sqrt(8.*8.31*t(:)/(33.E-3*pi))*gam/4.
    36883817 
    36893818!        h002: oh + ice -> products
    … …  
    36923821 
    36933822         gam = 0.03
    3694          h002(:) = surfice1d(:)*1.d-8       &
    3695                    *100.*sqrt(8.*8.31*t(:)/(17.d-3*pi))*gam/4.
     3823         h002(:) = surfice1d(:)*1.E-8       &
     3824                   *100.*sqrt(8.*8.31*t(:)/(17.E-3*pi))*gam/4.
    36963825
    36973826!---     h003: h2o2 + ice -> products
    … …  
    37003829 
    37013830         gam = 0.
    3702          h003(:) = surfice1d(:)*1.d-8        &
    3703                    *100.*sqrt(8.*8.31*t(:)/(34.d-3*pi))*gam/4.
     3831         h003(:) = surfice1d(:)*1.E-8        &
     3832                   *100.*sqrt(8.*8.31*t(:)/(34.E-3*pi))*gam/4.
    37043833      else
    37053834         h001(:) = 0.
    … …  
    37303859 
    37313860         gam = 0.2
    3732          h004(:) = surfdust1d(:)*1.d-8  &
    3733                    *100.*sqrt(8.*8.31*t(:)/(33.d-3*pi))*gam/4.
     3861         h004(:) = surfdust1d(:)*1.E-8  &
     3862                   *100.*sqrt(8.*8.31*t(:)/(33.E-3*pi))*gam/4.
    37343863 
    37353864!---     h005: h2o2 + dust -> products
    37363865 
    3737 !        gamma = 5.d-4
     3866!        gamma = 5.E-4
    37383867!        see dereus et al., atm. chem. phys., 2005
    37393868 
    3740          gam = 5.d-4
    3741          h005(:) = surfdust1d(:)*1.d-8  &
    3742                    *100.*sqrt(8.*8.31*t(:)/(34.d-3*pi))*gam/4.
     3869         gam = 5.E-4
     3870         h005(:) = surfdust1d(:)*1.E-8  &
     3871                   *100.*sqrt(8.*8.31*t(:)/(34.E-3*pi))*gam/4.
    37433872      else
    37443873         h004(:) = 0.
    … …  
    37653894!        Krasnopolsky (2010a)
    37663895
    3767       i001(:) = 1.d-20
     3896      i001(:) = 1.E-20
    37683897
    37693898      nb_phot = nb_phot + 1
    … …  
    37743903!        Lafferty et al; (1998)
    37753904
    3776       i002(:) = 2.2d-4
     3905      i002(:) = 2.2E-4
    37773906
    37783907      nb_phot = nb_phot + 1
    … …  
    37933922
    37943923integer :: i4, iz, nb_reaction_4
    3795 real    :: ep = 1.d-3
     3924real    :: ep = 1.E-3
    37963925integer, INTENT(IN) :: nz, nesp, nb_reaction_4_max
    3797 double precision, dimension(nb_reaction_4_max), INTENT(OUT) :: eps_4
     3926real, dimension(nb_reaction_4_max), INTENT(OUT) :: eps_4
    37983927
    37993928! number densities
    38003929
    3801 double precision, dimension(nz,nesp) :: c
     3930real, dimension(nz,nesp) :: c
    38023931
    38033932nb_reaction_4 = 0
    … …  
    45744703
    45754704do i4 = 1,nb_reaction_4
    4576    eps_4(i4) = max(eps_4(i4), 0.d0)
    4577    eps_4(i4) = min(eps_4(i4), 1.d0)
     4705   eps_4(i4) = max(eps_4(i4), 0.E+0)
     4706   eps_4(i4) = min(eps_4(i4), 1.E+0)
    45784707end do
    45794708
    … …  
    46014730integer :: iphot,i3,i4
    46024731
    4603 double precision :: Xphot_11,Xphot_21,Xphot_31
    4604 double precision :: X3_11,X3_21,X3_31
    4605 double precision :: X4_11,X4_12,X4_21,X4_22,X4_31,X4_32,X4_41,X4_42
     4732real :: Xphot_11,Xphot_21,Xphot_31
     4733real :: X3_11,X3_21,X3_31
     4734real :: X4_11,X4_12,X4_21,X4_22,X4_31,X4_32,X4_41,X4_42
    46064735real, INTENT(IN) :: dtx
    46074736
    4608 double precision, INTENT(IN), dimension(nz,nesp) :: c
     4737real, INTENT(IN), dimension(nz,nesp) :: c
    46094738
    46104739! matrix
    46114740
    4612 double precision, dimension(nesp,nesp), INTENT(OUT) :: mat
    4613 !double precision              :: d
     4741real, dimension(nesp,nesp), INTENT(OUT) :: mat
     4742!real              :: d
    46144743!integer                    :: code
    46154744!integer, dimension(nesp)   :: indx
    … …  
    46214750real, dimension(6*nb_reaction_3_max), INTENT(IN) :: indice_3
    46224751real, dimension(8*nb_reaction_4_max), INTENT(IN) :: indice_4
    4623 double precision, dimension(nz, nb_phot_max), INTENT(IN) :: v_phot
    4624 double precision, dimension(nz, nb_reaction_3_max), INTENT(IN) :: v_3
    4625 double precision, dimension(nz, nb_reaction_4_max), INTENT(IN) :: v_4
    4626 double precision, dimension(nb_reaction_4_max), INTENT(IN) :: eps_4
     4752real, dimension(nz, nb_phot_max), INTENT(IN) :: v_phot
     4753real, dimension(nz, nb_reaction_3_max), INTENT(IN) :: v_3
     4754real, dimension(nz, nb_reaction_4_max), INTENT(IN) :: v_4
     4755real, dimension(nb_reaction_4_max), INTENT(IN) :: eps_4
    46274756     
    46284757! initialisation
    … …  
    47394868integer, parameter :: nb_reaction_4_max = 84
    47404869     
    4741 double precision, dimension(n_lev,nb_phot_max) :: vphot
    4742 double precision, dimension(n_lev,nb_reaction_3_max) :: v3
    4743 double precision, dimension(n_lev,nb_reaction_4_max) :: v4
     4870real, dimension(n_lev,nb_phot_max) :: vphot
     4871real, dimension(n_lev,nb_reaction_3_max) :: v3
     4872real, dimension(n_lev,nb_reaction_4_max) :: v4
    47444873
    47454874!PRINT*,"DEBUT subroutine rate_save"
    … …  
    48024931             
    48034932         DO i_lev=1, n_lev
    4804          concentration(i_lev) = pres(i_lev)/(1.3806488d-19 * temperature(i_lev))     
     4933         concentration(i_lev) = pres(i_lev)/(1.3806488E-19 * temperature(i_lev))     
    48054934         END DO
    48064935         

  • trunk/LMDZ.VENUS/libf/phyvenus/nirco2abs.F

    r1310 r1442  
    11      SUBROUTINE nirco2abs(nlon,nlev,nplay,dist_sol,nq,pq,
    2      $     mu0,fract,pdtnirco2,
    3      $     co2vmr_gcm, ovmr_gcm)
     2     $     mu0,fract,pdtnirco2)
    43
    54       use dimphy
    65       use comgeomphy, only: rlatd, rlond     
     6       use chemparam_mod, only: i_co2, i_o
    77c       use compo_hedin83_mod2
    88
    … …  
    2323c   Stephen Lewis 2000
    2424c
    25 C   jan 2014 g.gilli     
     25c   oct 2014 g.gilli     Coupling with photochemical model
     26C   jan 2014 g.gilli     Revision (following martian non-lte param)   
    2627C   jun 2013 l.salmi     First adaptation to Venus and NIR NLTE param
    2728c   jul 2011 malv+fgg    New corrections for NLTE implemented
    … …  
    5960#include "nirdata.h"
    6061c#include "tracer.h"
    61 
     62#include "mmol.h"
    6263c-----------------------------------------------------------------------
    6364c    Input/Output
    6465c    ------------
    6566      integer,intent(in) :: nlon ! number of (horizontal) grid points
    66      
    6767      integer,intent(in) :: nlev ! number of atmospheric layers
     68
    6869      real,intent(in) :: nplay(nlon,nlev) ! Pressure
    6970      real,intent(in) :: dist_sol ! Sun-Venus distance (in AU)
    7071      integer,intent(in) :: nq ! number of tracers
    71       real,intent(in) :: pq(nlon,nlev,nq) ! tracers
     72      real,intent(in) :: pq(nlon,nlev,nq) ! mass mixing ratio tracers
    7273      real,intent(in) :: mu0(nlon) ! solar angle
    7374      real,intent(in) :: fract(nlon) ! day fraction of the time interval
    7475c      real,intent(in) :: declin ! latitude of sub-solar point
    75 
    76       real co2vmr_gcm(nlon,nlev),ovmr_gcm(nlon,nlev)
    77 
     76      real :: co2vmr_gcm(nlon,nlev), o3pvmr_gcm(nlon,nlev)
     77 
    7878      real,intent(out) :: pdtnirco2(nlon,nlev) ! heating rate (K/sec)
    7979
    … …  
    9595      integer,save :: io=0 ! index of "o" tracer
    9696
    97 ccc
     97cccc     parameters for CO2 heating fit
    9898c
    9999c     n_a  =  heating rate for Venusian day at p0, r0, mu =0 [K day-1]
    … …  
    104104      real n_a, n_p0, n_b, p_ctop
    105105
    106 cc Current values
    107        parameter (n_a = 18.13/86400.0)    !!     K/Eday  ---> K/sec   
     106   
     107cc "Nominal" values
     108       parameter (n_a = 18.13/86400.0)     !c     K/Eday  ---> K/sec   
    108109       parameter (p_ctop=13.2e2)
     110c    -- NLTE Param v3  --
     111       parameter (n_p0=0.008) 
     112       parameter (n_b=1.362)
     113
     114cc   -- Varoxy5
     115C       parameter (n_a = 20/86400.0)
     116C       parameter (p_ctop=870)   ! [Pa]
     117C       parameter (n_b=1.98)
     118C       parameter (n_p0=0.045)
     119
     120c      parameter (n_p0=0.1) !!!!cccc test varoxy5mod
     121c      parameter (n_b=0.9)
     122
    109123
    110124c    -- NLTE Param v2  --
    111 c       parameter (n_p0=0.01) 
     125C       parameter (n_p0=0.01) 
    112126c       parameter (n_b = 1.3)
    113  
    114 ccc TESTS 
    115 c       parameter (n_a = 18.4/86400.0 *0.6) 
    116 c       parameter (p_ctop=63.9e2)
    117 c       parameter (n_p0=0.012)
    118 c       parameter (n_b=1.9628251)
    119 
    120 
    121 c    -- NLTE Param v1  --
    122 c       parameter (n_p0=0.012)   
    123 c       parameter (n_b = 1.4)
    124 
    125 c    -- NLTE Param v3  --
    126 
    127        parameter (n_p0=0.008)   
    128        parameter (n_b = 1.362)
     127   
    129128
    130129
    … …  
    134133      real    p2011,cociente1,merge
    135134      real    cor0,oco2gcm
    136 
    137 c     co2heat is the heating by CO2 at p_ctop=9.3E03 Pa (cloud top 65 km) for a zero zenithal angle.
     135!!!!
     136c      real :: pic27(nlon,nlev), pic27b(nlon,nlev)
     137c      real :: pic43(nlon,nlev), picnir(nlon,nlev)
     138
     139c     co2heat is the heating by CO2 at p_ctop=13.2e2 for a zero zenithal angle.
    138140
    139141      co2heat0=n_a*(0.72/dist_sol)**2     
    140142
    141 
    142 CCCCCC   TEST: reduce/incrise by 50% nir Heating
    143 
    144 c      co2heat0  = co2heat0 * 2
     143CCCCCC   TEST: reduce by X% nir Heating
     144
     145c      co2heat0  = co2heat0 * 0.8
    145146
    146147
    … …  
    149150c     Initialisation
    150151c     --------------
    151 c      if (firstcall) then
    152 c        if (nircorr.eq.1) then
    153 cc          ! we will need co2 and o tracers
    154 c          ico2= igcm_co2
    155 c          if (ico2==0) then
    156 c            write(*,*) "nirco2abs error: I need a CO2 tracer"
    157 c            write(*,*) "     when running with nircorr==1"
    158 c           stop
    159 c          endif
    160 c          io=igcm_o
    161 c          if (io==0) then
    162 c            write(*,*) "nirco2abs error: I need an O tracer"
    163 c            write(*,*) "     when running with nircorr==1"
    164 c            stop
    165 c          endif
    166 c        endif
    167 c        firstcall=.false.
    168 c      endif
     152      if (firstcall) then
     153        if (nircorr.eq.1) then
     154c          ! we will need co2 and o tracers
     155          ico2= i_co2
     156          if (ico2==0) then
     157            write(*,*) "nirco2abs error: I need a CO2 tracer"
     158            write(*,*) "     when running with nircorr==1"
     159           stop
     160          endif
     161          io=i_o
     162          if (io==0) then
     163            write(*,*) "nirco2abs error: I need an O tracer"
     164            write(*,*) "     when running with nircorr==1"
     165            stop
     166          endif
     167        endif
     168        firstcall=.false.
     169      endif
    169170
    170171     
    … …  
    178179            zmu(ig)=sqrt(1224.*mu0(ig)*mu0(ig)+1.)/35.
    179180
    180             
     181           
    181182            if(nircorr.eq.1) then
    182183               do l=1,nlev
    … …  
    187188               call interpnir(oldoco2,pyy,nlev,oco21d,pres1d,npres)
    188189               call interpnir(alfa2,pyy,nlev,alfa,pres1d,npres)
    189 
     190               
    190191            endif
    191192
    192193            do l=1,nlev
     194     
    193195c           Calculations for the O/CO2 correction
    194196               if(nircorr.eq.1) then
    195197                  cor0=1./(1.+n_p0/nplay(ig,l))**n_b
    196                   if(co2vmr_gcm(ig,l).gt.1.e-6) then
    197                      oco2gcm=ovmr_gcm(ig,l)/co2vmr_gcm(ig,l)
     198                  if(pq(ig,l,ico2) .gt. 1.e-6) then
     199                     oco2gcm=pq(ig,l,io)/pq(ig,l,ico2)
     200
    198201                  else
    199202                     oco2gcm=1.e6
    200203                  endif
    201204                  cociente1=oco2gcm/oldoco2(l)
     205                 
     206c                  WRITE(*,*) "nirco2abs line 211", l, cociente1
     207
    202208                  merge=alog10(cociente1)*alfa2(l)+alog10(cor0)*
    203209     $                 (1.-alfa2(l))
    … …  
    209215                  cor1(l)=1.
    210216               endif
    211 
    212217
    213218              if(fract(ig).gt.0.) pdtnirco2(ig,l)=
    … …  
    216221c           Corrections from tabulation
    217222     $              * cor1(l) * p2011
    218 
    219 
     223             
    220224          enddo
    221225         enddo
    … …  
    250254
    251255               do l=1,nlev
    252                   if(nircorr.eq.1) then
    253                       cor0=1./(1.+n_p0/nplay(ig,l))**n_b
    254 c                     oco2gcm=ovmr_gcm(ig,l)/co2vmr_gcm(ig,l)
    255                      cociente1 = 1
    256                      merge=alog10(cociente1)*alfa2(l)+alog10(cor0)*
    257      $                    (1.-alfa2(l))
    258                      merge=10**merge
    259                      p2011=sqrt(merge)*cor0
    260                   else if (nircorr.eq.0) then
    261                      p2011=1.
    262                      cor1(l)=1.
    263                   endif
    264 
    265 c
    266 
    267                   if(fract_int(ig).gt.0.) pdtnirco2(ig,l)=
    268      &                 pdtnirco2(ig,l) + (1/float(nstep))*
    269      &                 co2heat0*sqrt((p_ctop*zmu(ig))/nplay(ig,l))
    270      &                 /(1.+n_p0/nplay(ig,l))**n_b
    271 !                      Corrections from tabulation
    272      $                 * cor1(l) * p2011
     256c           Calculations for the O/CO2 correction
     257               if(nircorr.eq.1) then
     258                  cor0=1./(1.+n_p0/nplay(ig,l))**n_b
     259                  oco2gcm=pq(ig,l,io)/pq(ig,l,ico2)
     260                  cociente1=oco2gcm/oldoco2(l)
     261                  merge=alog10(cociente1)*alfa2(l)+alog10(cor0)*
     262     $                 (1.-alfa2(l))
     263                  merge=10**merge
     264                  p2011=sqrt(merge)*cor0
     265
     266               else if (nircorr.eq.0) then
     267                  p2011=1.
     268                  cor1(l)=1.
     269               endif
     270
     271               if(fract_int(ig).gt.0.) pdtnirco2(ig,l)=
     272     &              pdtnirco2(ig,l) + (1/float(nstep))*
     273     &              co2heat0*sqrt((p_ctop*zmu(ig))/nplay(ig,l))
     274     &              /(1.+n_p0/nplay(ig,l))**n_b
     275!     Corrections from tabulation
     276     $              * cor1(l) * p2011
    273277
    274278               enddo
    … …  
    276280         end do
    277281     
    278       END IF
     282
     283      END IF 
    279284
    280285      return
    281286      end
    282 
    283287
    284288     
    … …  
    294298      do n1=1,nlev
    295299         if(p(n1) .gt. 1500. .or. p(n1) .lt. 1.0e-13) then
    296             escout(n1) = 0.0
     300c            escout(n1) = 0.0
     301            escout(n1) = 1.e-15
    297302         else
    298303            do n = 1,nl-1

  • trunk/LMDZ.VENUS/libf/phyvenus/nlte_setup.F

    r1310 r1442  
    178178
    179179      k20x = 3.d-12
     180c  TEST GG: double the values of Kvv as recently found by Sharma et al.2014
     181c      k20x = 6.d-12   
     182c  TEST GG: use the minimum value of the experimental bracket's values [1-6]
     183c      k20x = 1.d-12
    180184      k20xc = k20x * rf20
    181185      k20xb = 2.d0 * k20xc
    … …  
    189193      k19xcc = k19xcb
    190194
    191 ccc test gab cccc    !!!!!      <---------------------------------------
    192195      factor = 2.5d0
    193 c      factor = 3.5d0
    194 
    195196      k19xba = factor * k19xca
    196197      k19xbb = factor * k19xcb
    … …  
    231232
    232233      k21x = 2.49d-11
     234CCC TEST GG
     235c      k21x =  2.49d-11*0.5
     236C      k21x =  2.49d-11*2
     237
    233238      k21xb = k21x
    234239      k21xa = 3.d0/2.d0 * k21xb

  • trunk/LMDZ.VENUS/libf/phyvenus/nlte_tcool.F

    r1310 r1442  
    3333      implicit none
    3434
    35 #include "dimensions.h"
    36 #include "nlte_paramdef.h"
    37 #include "nlte_commons.h"
    38 #include "YOMCST.h"
     35      include "dimensions.h"
     36      include "nlte_paramdef.h"
     37      include "nlte_commons.h"
     38      include "YOMCST.h"
    3939
    4040c     Arguments
    … …  
    4848      real q15umco2_gcm(nlon,nlev) ! is in K/RDAY (see hrkday_convert)
    4949                                   ! but converted to K/s (see CONVERSION_KDAY_Ksec )
    50 !     real auxgcm(nlev)
    5150      real*8 auxgcmd(nlev), aux2gcmd(nlev)
    5251      real zmin_gcm
    5352      integer ierr
    5453      real*8 varerr
    55 
    56 
    5754
    5855c     local variables and constants
    … …  
    6663      real co2_ig(nlev),n2_ig(nlev),co_ig(nlev),o3p_ig(nlev)
    6764      real mmean_ig(nlev),cpnew_ig(nlev)
    68 !!!!!
    69 c      real cpnew(nlon,nlev)
    70 c      real rnew(nlon,nlev)
    71 c      real mmean(nlon,nlev)
    72 
    7365
    7466
    … …  
    9082            mmean_ig(l)=mmean(ig,l)
    9183            cpnew_ig(l)=cpnew(ig,l)
     84
    9285         enddo
    9386
    … …  
    318311!      print*, zl
    319312
    320                     ! Creamos el perfil del NLTE modelo completo interpolando
    321 
    322       call interhunt (    pl,zl,nl,      p_gcm,z_gcm,nlev, 2) ! [atm]
     313! Creamos el perfil del NLTE modelo completo interpolando
     314
     315      call interhunt (    pl,zl,nl,  p_gcm,z_gcm,nlev, 2) ! [atm]
    323316      call interhunt5veces
    324317     $     ( t, co2vmr, n2vmr, covmr, o3pvmr,
    … …  
    354347            write (*,*) ' i, t(i), pl(i) =', i, t(i), pl(i)
    355348         endif
    356          if (t(i) .lt. 20.0) then
     349         if (t(i) .lt. 50.0) then
    357350            write (*,*) '!!!! WARNING    Temp lower than Histogram.'
    358351            write (*,*) ' Histogram will be extrapolated. '

  • trunk/LMDZ.VENUS/libf/phyvenus/physiq.F

    r1310 r1442  
    6464      USE write_field_phy
    6565      USE iophy
    66       use cpdet_mod, only: cpdet, t2tpot
     66      USE cpdet_mod, only: cpdet, t2tpot
    6767      USE chemparam_mod
    6868      USE conc
    … …  
    240240      EXTERNAL conduction
    241241      EXTERNAL molvis
     242      EXTERNAL moldiff_red
     243
    242244c
    243245c Variables locales
    … …  
    260262      REAL zdtime, zlongi
    261263c
    262       INTEGER i, k, iq, ig, j, ll
     264      INTEGER i, k, iq, ig, j, ll, ilon, ilat, ilev
    263265c
    264266      REAL zphi(klon,klev)
    … …  
    301303      real d_v_molvis(klon,klev)     ! (m/s) /s
    302304
     305c Tendencies due to molecular diffusion
     306      real d_q_moldif(klon,klev,nqmax)
     307
    303308c
    304309c Variables liees a l'ecriture de la bande histoire physique
    … …  
    322327      REAL :: tr_seri(klon,klev,nqmax)
    323328      REAL :: d_tr(klon,klev,nqmax)
     329
     330c Champ de modification de la temperature par rapport a VIRAII
     331      REAL delta_temp(klon,klev)
     332c      SAVE delta_temp
     333      REAL mat_dtemp(33,50)
     334      SAVE mat_dtemp
    324335
    325336c Variables tendance sedimentation
    … …  
    493504C TRACEURS
    494505C source dans couche limite
    495          source = 0.0 ! pas de source, pour l'instant
     506         source(:,:) = 0.0 ! pas de source, pour l'instant
    496507c---------
    497508
    … …  
    510521            rnew(ig,j)=R
    511522            cpnew(ig,j)=cpdet(tmoy(j))
    512 c            print*, ' physique  l503'
    513 c            print*,  j, cpdet(tmoy(j))
    514              mmean(ig,j)=RMD
     523            mmean(ig,j)=RMD
    515524            akknew(ig,j)=1.e-4
    516525          enddo
    … …  
    522531         call compo_hedin83_init2
    523532      ENDIF
    524       if (callnlte) call nlte_setup
    525       if(callnirco2.and.(nircorr.eq.1)) call nir_leedat         
     533      if (callnlte.and.nltemodel.eq.2) call nlte_setup
     534      if (callnirco2.and.nircorr.eq.1) call nir_leedat         
    526535c---------
    527536     
    … …  
    627636      endif
    628637           
    629       if ((nlon .GT. 1) .AND. ok_chem) then
     638      if ((nlon .GT. 1) .AND. (ok_chem.OR.ok_cloud)) then
    630639c !!! DONC 3D !!!
    631640        CALL chemparam_ini()
    … …  
    636645        CALL cloud_ini(nlon,nlev)
    637646      endif
     647
     648c======================================================================
     649c      Lecture du fichier DeltaT
     650c======================================================================
     651
     652c     ATTENTION tout ce qui suit est pour un 48*32*50
     653
     654      if (ok_deltatemp) then
     655
     656      print*,'lecture de VenusDeltaT.txt '
     657      open(99, form = 'formatted', status = 'old', file =
     658     &     'VenusDeltaT.dat')
     659      print*,'Ouverture de VenusDeltaT.txt '
     660
     661      DO ilev = 1, klev
     662         read(99,'(33(1x,e13.6))') (mat_dtemp(ilat,ilev),ilat=1,33)
     663         print*,'lecture de VenusDeltaT.txt ligne:',ilev
     664      ENDDO
     665     
     666      close(99)
     667      print*,'FIN lecture de VenusDeltaT.txt ok.'
     668
     669      DO k = 1, klev
     670      DO i = 1, klon     
     671         ilat=(rlatd(i)/5.625) + 17.
     672         delta_temp(i,k)=mat_dtemp(INT(ilat),k)
     673      ENDDO
     674      ENDDO
     675     
     676      endif
    638677       
    639678      ENDIF ! debut
    640 c====================================================================
     679c======================================================================
    641680c======================================================================
    642681
    … …  
    830869! Case 3: Full chemistry and/or clouds
    831870
    832          call phytrac_chimie(                 
     871         if (ok_deltatemp) then
     872!           PRINT*,'Def de delta_temp'
     873           DO k = 1, klev
     874           DO i = 1, klon     
     875             ilat=(rlatd(i)/5.625) + 17.
     876!             PRINT*,INT(ilat),rlatd(i),mat_dtemp(INT(ilat),k)
     877             delta_temp(i,k)=mat_dtemp(INT(ilat),k)
     878           ENDDO
     879           ENDDO
     880     
     881         endif
     882
     883         if (ok_deltatemp) then
     884! Utilisation du champ de temperature modifie         
     885           call phytrac_chimie(                             
    833886     I             debut,
    834887     I             gmtime,
    835888     I             nqmax,
    836      I             nlon,
     889     I             klon,
    837890     I             rlatd,
    838891     I             rlond,
    839892     I             nlev,
    840893     I             dtime,
    841      I             t_seri,pplay,
    842      O             tr_seri,
    843      O             NBRTOT,
    844      O             WH2SO4,
    845      O             rho_droplet)
     894     I             t_seri+delta_temp,
     895     I             pplay,
     896     O             tr_seri)
     897         else
     898         
     899           call phytrac_chimie(                             
     900     I             debut,
     901     I             gmtime,
     902     I             nqmax,
     903     I             klon,
     904     I             rlatd,
     905     I             rlond,
     906     I             nlev,
     907     I             dtime,
     908     I             t_seri,
     909     I             pplay,
     910     O             tr_seri)
     911         endif
    846912
    847913c        CALL WriteField_phy('Pression',pplay,nlev)
    … …  
    856922         if (ok_sedim) then
    857923
     924         if (ok_deltatemp) then
     925! Utilisation du champ de temperature modifie 
    858926           CALL new_cloud_sedim(
    859      I               klon,
    860      I               nlev,
    861      I               dtime,
    862      I               pplay,
    863      I               paprs,
    864      I               t_seri,
    865      I               WH2SO4,
    866      I               tr_seri,
    867      I               nqmax,
    868      I               NBRTOT,
    869      I               rho_droplet,
    870      O               Fsedim,
    871      O               d_tr_sed,
    872      O               d_tr_ssed)
    873 
    874           DO k = 1, klev
    875            DO i = 1, klon
    876      
    877 c        WRITE(88,"(11(e15.8,','))") pplay(5,25),
    878 c     &  t_seri(5,25),tr_seri(5,25,i_h2oliq),
    879 c     &  tr_seri(5,25,i_h2o),tr_seri(5,25,i_h2so4liq),
    880 c     &  tr_seri(5,25,i_h2so4),NBRTOT(5,25),WH2SO4(5,25),
    881 c     &  Fsedim(5,25),d_tr_sed(5,25,1),d_tr_sed(5,25,2)
     927     I                 klon,
     928     I               nlev,
     929     I               dtime,
     930     I                 pplay,
     931     I               paprs,
     932     I               t_seri+delta_temp,
     933     I                 tr_seri,
     934     O               d_tr_sed,
     935     O               d_tr_ssed,
     936     I               nqmax,
     937     O                 Fsedim)
     938         else
     939         
     940           CALL new_cloud_sedim(
     941     I                 klon,
     942     I               nlev,
     943     I               dtime,
     944     I                 pplay,
     945     I               paprs,
     946     I               t_seri,
     947     I                 tr_seri,
     948     O               d_tr_sed,
     949     O               d_tr_ssed,
     950     I               nqmax,
     951     O                 Fsedim)
     952
     953         endif
     954
     955        DO k = 1, klev
     956         DO i = 1, klon
    882957
    883958c--------------------
    … …  
    888963        PRINT*,'d_tr_sed Nan?',d_tr_sed(i,k,:),'Temp',t_seri(i,k)
    889964        PRINT*,'lat-lon',i,'level',k,'dtime',dtime
    890         PRINT*,'NBRTOT',NBRTOT(i,k),'F_sed',Fsedim(i,k)
     965        PRINT*,'F_sed',Fsedim(i,k)
    891966        PRINT*,'==============================================='
    892967                d_tr_sed(i,k,:)=0.
    … …  
    901976        Fsedim(i,k)     = Fsedim(i,k) / dtime
    902977     
    903            ENDDO
    904978          ENDDO
     979         ENDDO
    905980     
    906981        Fsedim(:,klev+1) = 0.
    … …  
    9881063         ENDDO
    9891064         ENDDO
     1065   
    9901066         DO iq=1, nqmax
     1067c  AS: changement
     1068c  Pourquoi d_tr_vdf(1,1,iq) et tr_seri(1,1,iq)
     1069c  et pas d_tr_vdf(:,:,iq) tr_seri(:,:,iq)
     1070c  Je vois pas en quoi cltrac ne prendrait en compte que le traceur à la surface et au point 1 en klon
     1071c
     1072
     1073c  Je garde le source(:,iq) parce que je comprend pas sinon source
     1074c   dimension(klon,nqmax) et flux dans cltrac (klon) ???
     1075
     1076c             CALL cltrac(dtime,ycoefh,t_seri,
     1077c     s               tr_seri(1,1,iq),source(:,iq),
     1078c     e               paprs, pplay,delp,
     1079c     s               d_tr_vdf(1,1,iq))
     1080     
    9911081             CALL cltrac(dtime,ycoefh,t_seri,
    992      s               tr_seri(1,1,iq),source,
     1082     s               tr_seri(:,:,iq),source(:,iq),
    9931083     e               paprs, pplay,delp,
    994      s               d_tr_vdf(1,1,iq))
     1084     s               d_tr_vdf(:,:,iq))
     1085     
    9951086             tr_seri(:,:,iq) = tr_seri(:,:,iq) + d_tr_vdf(:,:,iq)
    9961087             d_tr_vdf(:,:,iq)= d_tr_vdf(:,:,iq)/dtime          ! /s
     1088
     1089         DO k = 1, klev
     1090         DO i = 1, klon
     1091            tr_seri(i,k,iq) = tr_seri(i,k,iq) + d_tr_vdf(i,k,iq)
     1092            d_tr_vdf(i,k,iq)= d_tr_vdf(i,k,iq)/dtime          ! /s
    9971093         ENDDO
    998       endif
     1094         ENDDO
     1095         
     1096         ENDDO !nqmax
     1097
     1098       endif
    9991099
    10001100      IF (if_ebil.ge.2) THEN
    … …  
    10841184           d_tr_ajs(:,:,:)= d_tr_ajs(:,:,:)/dtime  ! /s
    10851185         endif
    1086 
    10871186      endif
    10881187
    … …  
    11041203      END IF
    11051204
     1205
    11061206c====================================================================
    11071207c RAYONNEMENT
    11081208c====================================================================
    11091209
    1110 c-----------------------------------------------------------------------
     1210c------------------------------------
    11111211c    . Compute radiative tendencies :
    11121212c------------------------------------
    … …  
    11181218c     PRINT*,'dtimerad,dtime,radpas',dtimerad,dtime,radpas
    11191219           
    1120 c Calcul pour Cp rnew et mmean avec traceurs (Cp independant de T !! )
    1121        IF(callnlte.or.callthermos) THEN                                 
     1220
     1221c------------------------------------
     1222c    . Compute mean mass, cp and R :
     1223c------------------------------------
     1224
     1225      if(callthermos) then
     1226         call concentrations2(pplay,t_seri,d_t,tr_seri, nqmax,
     1227     &                        pdtphys)
     1228
     1229      endif
     1230
     1231
     1232cc!!! ADD key callhedin
     1233
     1234      IF(callnlte.or.callthermos) THEN                                 
    11221235         call compo_hedin83_mod(pplay,rmu0,   
    11231236     &           co2vmr_gcm,covmr_gcm,ovmr_gcm,n2vmr_gcm,nvmr_gcm)
     1237
     1238         IF(ok_chem) then
     1239 
     1240CC  !! GG : Using only mayor species tracers abundances to compute NLTE heating/cooling
     1241
     1242CC               Conversion [mmr] ---> [vmr]
     1243       
     1244                 co2vmr_gcm(:,:) = tr_seri(1:nlon,1:nlev,i_co2)*
     1245     &                             mmean(1:nlon,1:nlev)/M_tr(i_co2)
     1246                 covmr_gcm(:,:)  = tr_seri(1:nlon,1:nlev,i_co)*
     1247     &                              mmean(1:nlon,1:nlev)/M_tr(i_co)
     1248                 ovmr_gcm(:,:)   = tr_seri(1:nlon,1:nlev,i_o)*
     1249     &                             mmean(1:nlon,1:nlev)/M_tr(i_o)
     1250                 n2vmr_gcm(:,:)   = tr_seri(1:nlon,1:nlev,i_n2)*
     1251     &                             mmean(1:nlon,1:nlev)/M_tr(i_n2)
     1252
     1253         ENDIF
     1254
    11241255       ENDIF   
    11251256
    1126       if(callthermos) then
    1127          call concentrations2(pplay,t_seri,d_t,co2vmr_gcm, n2vmr_gcm,
    1128      &          covmr_gcm, ovmr_gcm,nvmr_gcm,pdtphys)
    1129       endif
    1130 
    1131 
    1132 c          NLTE cooling from CO2 emission
    1133 c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     1257c
     1258c   NLTE cooling from CO2 emission
     1259c   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    11341260
    11351261        IF(callnlte) THEN                                 
    11361262            if(nltemodel.eq.0.or.nltemodel.eq.1) then
    1137                 CALL nltecool(klon, klev, pplay*9.869e-6, t_seri,
    1138      $                    co2vmr_gcm,n2vmr_gcm, covmr_gcm, ovmr_gcm,
    1139      $                    d_t_nlte)
     1263                CALL nltecool(klon, klev, nqmax, pplay*9.869e-6, t_seri,
     1264     $                    tr_seri, d_t_nlte)
    11401265            else if(nltemodel.eq.2) then                               
    1141                 CALL nlte_tcool(klon,klev,pplay*9.869e-6,             
     1266               CALL nlte_tcool(klon,klev,pplay*9.869e-6,             
    11421267     $               t_seri,zzlay,co2vmr_gcm, n2vmr_gcm, covmr_gcm,
    11431268     $               ovmr_gcm,d_t_nlte,ierr_nlte,varerr )
    … …  
    11621287     $        CALL nlthermeq(klon, klev, paprs, pplay)
    11631288
    1164 
    1165 c          LTE radiative transfert / solar / IR matrix
    1166 c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    1167 
     1289c
     1290c       LTE radiative transfert / solar / IR matrix
     1291c       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    11681292      CALL radlwsw
    11691293     e            (dist, rmu0, fract, zzlev,
    … …  
    11711295
    11721296
    1173 c          CO2 near infrared absorption
    1174 c          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     1297c       CO2 near infrared absorption
     1298c      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    11751299
    11761300        d_t_nirco2(:,:)=0.
    11771301        if (callnirco2) then
    1178            call nirco2abs (klon, klev, pplay, dist, nqmax, qx,
    1179      .                 rmu0, fract, d_t_nirco2,
    1180      .                 co2vmr_gcm, ovmr_gcm)
     1302           call nirco2abs (klon, klev, pplay, dist, nqmax, tr_seri,
     1303     .                 rmu0, fract, d_t_nirco2)
    11811304        endif
    11821305
    … …  
    12091332        IF (callthermos) THEN
    12101333
    1211 c        call thermosphere(zplev,zplay,dist_sol,
    1212 c     $     mu0,ptimestep,ptime,zday,tsurf,zzlev,zzlay,
    1213 c     &     pt,pq,pu,pv,pdt,pdq,
    1214 c     $     zdteuv,zdtconduc,zdumolvis,zdvmolvis,zdqmoldiff)
    1215 
    1216            call euvheat(klon, klev, t_seri,paprs,pplay,zzlay,
    1217      $          rmu0,pdtphys,gmtime,rjourvrai,
    1218 C     $                 pq,pdq,zdteuv)
    1219      $          co2vmr_gcm, n2vmr_gcm, covmr_gcm,
    1220      $          ovmr_gcm,nvmr_gcm,d_t_euv )
    1221 
     1334c           call euvheat(klon, klev,t_seri,paprs,pplay,zzlay,
     1335c     $          rmu0,pdtphys,gmtime,rjourvrai, co2vmr_gcm, n2vmr_gcm,
     1336c     $          covmr_gcm, ovmr_gcm,d_t_euv )
     1337           call euvheat(klon, klev, nqmax, t_seri,paprs,pplay,zzlay,
     1338     $         rmu0,pdtphys,gmtime,rjourvrai,
     1339     $         tr_seri, d_tr, d_t_euv )
     1340               
    12221341           DO k=1,klev
    12231342              DO ig=1,klon
    … …  
    12621381            call molvis(klon, klev, pdtphys,
    12631382     $            pplay,paprs,t_seri,
    1264      $            v,tsurf,zzlev,zzlay,d_u_molvis)
     1383     $            v,tsurf,zzlev,zzlay,d_v_molvis)
    12651384
    12661385            DO k=1,klev
    … …  
    12711390               ENDDO
    12721391            ENDDO
    1273 
    1274          ENDIF  ! callthermos
     1392        ENDIF
     1393
     1394
     1395!  --  MOLECULAR DIFFUSION ---
     1396
     1397          d_q_moldif(:,:,:)=0
     1398
     1399         IF (callthermos .and. ok_chem) THEN
     1400
     1401             call moldiff_red(klon, klev, nqmax,
     1402     &                   pplay,paprs,t_seri, tr_seri, pdtphys,
     1403     &                   zzlay,d_t_euv,d_t_conduc,d_q_moldif)
     1404
     1405
     1406! --- update tendencies tracers ---
     1407
     1408          DO iq = 1, nqmax
     1409           DO k=1,klev
     1410              DO ig=1,klon
     1411                tr_seri(ig,k,iq)= tr_seri(ig,k,iq)+
     1412     &                           d_q_moldif(ig,k,iq)*dtime ! [Kg/kg]?
     1413              ENDDO
     1414            ENDDO
     1415           ENDDO
     1416           
     1417
     1418         ENDIF  ! callthermos & ok_chem
    12751419
    12761420c====================================================================

  • trunk/LMDZ.VENUS/libf/phyvenus/phytrac_chimie.F

    r1305 r1442  
    1515     I                    temp,
    1616     I                    pplev,
    17      O                    trac,
    18      O                    NBRTOT_droplet,
    19      O                    W_H2SO4,
    20      O                    rho)
    21 
     17     O                    trac)
    2218c======================================================================
    2319c Auteur(s) FH
    … …  
    2824cAA 1/ le call phytrac se fait avec nqmax
    2925c======================================================================
     26c      USE ioipsl
     27c      USE infotrac
     28c      USE control_mod
     29c      USE dimphy
     30c      USE comgeomphy
    3031      USE chemparam_mod
     32      use conc, only: mmean
    3133      IMPLICIT none
    3234     
     35c#include "dimensions.h"
    3336#include "clesphys.h"
     37c#include "temps.h"
     38c#include "paramet.h"
     39c#include "comcstfi.h" !me permet de recuperer mugaz et d'autres constantes comme rad,pi etc
    3440#include "YOMCST.h"
    3541c======================================================================
    … …  
    5359      INTEGER  n_lev  ! nombre de couches verticales
    5460      INTEGER  nqmax ! nombre de traceurs auxquels on applique la physique
    55 c      INTEGER  nbapp_cloud, i_app_cloud
     61
    5662      real  pdtphys  ! pas d'integration pour la physique (seconde)
    5763      real  lat(n_lon), lat_local(n_lon)
    5864      real  lon(n_lon), lon_local(n_lon)
    5965      real  temp(n_lon,n_lev) ! temp
    60       real  trac(n_lon,n_lev,nqmax) ! traceur
     66      real  trac(n_lon,n_lev,nqmax) ! traceur
     67      real  trac_sav(n_lon,n_lev,nqmax)
     68      real  trac_sum(n_lon,n_lev)
    6169      real  pplev(n_lon,n_lev)  ! pression pour le mileu de chaque couche (en Pa)
    6270      real  lon_sun
     71
    6372      logical debutphy       ! le flag de l'initialisation de la physique
    64 c      character*7 modname
    65 
    66 C
    67 C----------------------------------------------------------------------------
    68 C     Model cloud:
    69 C     Aerosol and PSC variables:
    70       real  NBRTOT_droplet(n_lon,n_lev)
    71       real  W_H2SO4(n_lon,n_lev)
    72       real  W_H2O(n_lon,n_lev)
    73       real  rho(n_lon,n_lev)
    74 C----------------------------------------------------------------------------
    75 C----------------------------------------------------------------------------
    76 C     Time variables:
    77       REAL, save :: dT_cloud
    78 C----------------------------------------------------------------------------   
    79 C----------------------------------------------------------------------------
     73
    8074C     Auxilary variables:
    8175 
    82       REAL mrtwv,mrtsa,mrwv,mrsa,
    83      +     ppwv, psatwv,
    84      +     ps_sa,satps_sa
     76      REAL, DIMENSION(n_lon,n_lev) :: mrtwv,mrtsa,
     77     +                                mrwv,mrsa
     78     
    8579C    ps_sa: satur pressure pure SA
    8680C    satps_sa: satur pres over mixture in dyne/cm2=Pa/10
    … …  
    10195
    10296      if (debutphy) then
    103          
    104       PRINT*,'PRECISION REAL'
    105       PRINT*,precision(NBRTOT_droplet(1,1)), range(NBRTOT_droplet(1,1))
    10697     
    10798         if (n_lon .EQ. 1) then           
    … …  
    119110c         endif
    120111           
    121          IF (reinit_trac) THEN
    122          PRINT*,'REINIT MIXING RATIO TRACEURS'
     112       IF (reinit_trac) THEN
     113       PRINT*,'REINIT MIXING RATIO TRACEURS'
    123114
    124115c       =============================================================
    125116c                                       Passage de Rm à Rv
    126117c       =============================================================
    127 c     Necessaire si on reprend les start.nc qui sont en MMR
    128       DO iq=1,nqmax
    129       trac(:,:,iq)=trac(:,:,iq)*RMD/M_tr(iq)
    130       END DO
     118c       Necessaire si on reprend les start.nc qui sont en MMR
     119
     120         DO iq=1,nqmax
     121          trac(:,:,iq)=trac(:,:,iq)*mmean(:,:)/M_tr(iq)
     122         END DO
    131123c       =============================================================
    132124         
    133      
    134125c=============================================================
    135126c               Initialisation des profils traceurs en Rv
    136127c=============================================================
    137          trac(:,:,:)=1.0d-30
    138      
    139          trac(:,:,i_co2)=0.965d0 * RMD / M_tr(i_co2)
    140 
    141          trac(:,:,i_co)=25.0d-6
    142 
    143  
    144       trac(:,:,i_h2so4)=1.0d-21
    145       trac(:,:,i_h2o)=1.0d-21
    146 
    147 c     !!! SANS NUAGE !!!       
    148 c        trac(:,1:29,i_ocs)=1.0d-6
    149 c        trac(:,29:40,i_ocs)=1.0e-9
    150 c       trac(:,:,i_so2)=1.d-6
    151 c       trac(:,:,i_h2o)=1.0d-6
     128c initialisation sert a mettre les valeurs voulues par utilisateur pour
     129c chaque traceur
     130c exemple: trac(ilon,ilev,q)=xx
     131
     132c     trac_sav sert a sauver les valeurs initiales du start.nc     
     133      trac_sav=trac
     134
     135c     On initialise les traceurs a zero obligatoire pour la chimie
     136      trac(:,:,:)=1.0E-30
    152137
    153138c     !!! AVEC NUAGE !!!
    154          trac(:,1:20,i_ocs)=3.d-6
    155 
    156             DO i=21,26
    157             trac(:,i,i_ocs)=trac(:,i-1,i_ocs)-0.3d-6
    158             END DO
    159        
    160 c       DO i=21,30
    161 c       trac(:,i,i_ocs)=trac(:,i-1,i_ocs)-0.3d-6
    162 c       END DO
    163        
    164          trac(:,1:26,i_hcl)=0.2d-6
    165 
    166 c      trac(:,:,i_hcl)=0.2d-6
    167 
    168 c       Initialisation SO2 Bertaux et De Bergh 2007 JGR
    169 c         trac(:,1:26,i_so2)=20.d-6
    170 c            DO i=2,20
    171 c            trac(:,i,i_so2)=trac(:,i-1,i_so2)+(100./19.)*0.25d-6
    172 c            END DO
    173 c            DO i=21,22
    174 c            trac(:,i,i_so2)=trac(:,i-1,i_so2)-(100./9.)*0.25d-6
    175 c            END DO
    176 
    177 c       DO i=21,29
    178 c       trac(:,i,i_so2)=trac(:,i-1,i_so2)-(100./9.)*1d-6
    179 c       END DO
    180 
    181 c      trac(:,1:30,i_so2)= 100.0d-6
    182 c       trac(:,30,i_so2)=20.0d-6
    183 c      trac(:,31,i_so2)=10.0d-6
    184 c      trac(:,32,i_so2)=1.0d-6
    185 c      trac(:,33,i_so2)=0.1d-6
    186 c      trac(:,34:42,i_so2)=0.02d-6
    187 c      trac(:,43:46,i_so2)=0.07d-6
    188 c      trac(:,47:50,i_so2)=0.05d-6
    189 
    190 c      trac(:,1:28,i_h2o)=30.0d-6
    191 c      trac(:,29:50,i_h2o)=5.0d-6
    192       trac(:,15:50,i_h2o)=10.0d-6
    193 c      trac(:,15:35,i_h2so4)=17.0d-6
    194 c       DO i=23,35
    195 c       trac(:,i,i_h2o)=(3.d-6-30.0d-6)/12.0*(-23.0+i)+trac(:,22,i_h2o)
    196 c       END DO
    197 c       trac(:,36:50,i_h2o)=3.0d-6
    198        
    199       trac(:,15:50,i_h2so4)=20.0d-6
    200 c      trac(:,29:50,i_h2so4)=1.0d-9
    201 c      trac(:,1:10,i_h2)=1.0d-10
    202 c      trac(:,11:20,i_h2)=1.0d-9
    203 c      trac(:,21:35,i_h2)=1.0d-8
    204 c      trac(:,36:50,i_h2)=1.0d-7     
     139      trac(:,1:22,i_ocs)=3.E-6
     140      trac(:,:,i_hcl)=0.4E-6
     141      trac(:,1:22,i_so2)=10.E-6
     142      trac(:,1:22,i_h2o)=30.0E-6
     143
     144c     remettre tous les traceurs du start => trac(:,:,:)=trac_sav(:,:,:)
     145
     146c     N2 n est pas encore une espece chimique du modele chimique
     147c     traceur passif pour la chimie-transport
     148      trac(:,:,i_n2)=0.35d-1
    205149   
     150!!!! GG:   Initialization CO2 = 1 - qtot
     151!!    It assures that vmr_tot = 1
     152c     On a donc le CO2 qui est le restant d atmosphere Venus 
     153         trac_sum(:,:)=0.0
     154        DO iq=2,nqmax
     155         trac_sum(:,:)= trac_sum(:,:) + trac(:,:,iq)
     156        END DO
     157
     158        trac(:,:,i_co2)= 1-trac_sum(:,:)
     159       
    206160c=============================================================
    207161     
    … …  
    210164c       =============================================================
    211165         DO iq=1,nqmax
    212          trac(:,:,iq)=trac(:,:,iq)*M_tr(iq)/RMD
     166          trac(:,:,iq)=trac(:,:,iq)*M_tr(iq)/mmean(:,:)
    213167         END DO
    214168c       =============================================================
    215 
    216 c       Ecriture fichier initialisation
    217 c       PRINT*,'Ecriture Initial_State.csv'
    218 c       OPEN(88,file='Initial_State.csv',
    219 c     & form='formatted')
    220      
    221 c      DO ilon=1,n_lon
    222 c        DO ilev=1,n_lev
    223 c        WRITE(88,"(36(e15.8,','))") R_MEDIAN(ilon,ilev),
    224 c     &  STDDEV(ilon,ilev),trac(ilon,ilev,1:nqmax)
    225 c        ENDDO
    226 c      ENDDO
    227 c      PRINT*,'FIN Ecriture Initial_State.csv'
    228      
    229          ENDIF  !FIN REINIT TRAC
     169   
     170       ENDIF  !FIN REINIT TRAC
     171
    230172       
    231173c-------------
    232174c fin debutphy
    233175c-------------
     176
    234177      ENDIF  ! fin debutphy
    235178
    … …  
    237180c                                       Passage de Rm à Rv
    238181c       =============================================================
    239       DO iq=1,nqmax
    240       trac(:,:,iq)=trac(:,:,iq)*RMD/M_tr(iq)
    241       END DO
    242 c       =============================================================
    243 
    244 
    245 c=============================================================
    246 c                       Boucle sur les lon, lat (n_lon)
    247 c=============================================================
    248 c      PRINT*, 'gmtime', gmtime*RDAY
    249 c      PRINT*, 'RDAY', RDAY
    250      
    251       lon_sun = (0.5 - gmtime) * 2.0 * RPI
    252       lon_local = lon * RPI/180.0d0
    253       lat_local = lat * RPI/180.0d0
    254        
    255       DO ilon=1, n_lon
    256 
    257 c     calcul sza_local pour obtenir des sza_local > 90, utile pour la chimie
    258       sza_local = acos(cos(lat_local(ilon))*cos(lon_local(ilon))*
    259      & cos(lon_sun) + cos(lat_local(ilon))*sin(lon_local(ilon))
    260      & *sin(lon_sun))* 180.0d0/RPI
    261      
    262 c      PRINT*,'sza_local :', sza_local
    263 
    264          IF (ok_cloud) THEN
    265 c      PRINT*,'DEBUT CLOUD'
    266                
    267       dT_cloud=pdtphys
    268      
    269      
    270 c      nbapp_cloud=NINT(pdtphys/dT_cloud)
    271 c      PRINT*,'pdtphys',pdtphys
    272 c      PRINT*,'nbapp_cloud',nbapp_cloud
     182       DO iq=1,nqmax
     183         trac(:,:,iq)=MAX(trac(:,:,iq)*mmean(:,:)/M_tr(iq),1.E-30)
     184       END DO
     185c       =============================================================
     186
     187
    273188c       =============================================================
    274189c                        Appel Microphysique (sans nucleation)
    … …  
    276191c       =============================================================
    277192
    278 c      FIXE un profil de temperature def dans fichier temp
    279       if (n_lon .EQ. 1) then
    280       OPEN(13,file='temp',status='old',form='formatted')
    281       DO ilev=1,n_lev
    282         READ (13,*) temp(n_lon,ilev)
    283       ENDDO
    284       CLOSE(13)
    285       endif
    286                  
    287       DO ilev=1, n_lev
    288 c      PRINT*,'DEBUT INIT CALL CLOUD'
    289 c     ppwv et pplev en Pa
    290        
    291 c      PRINT*,'@@@@ IN CLOUD @@@@'     
    292      
     193         IF (ok_cloud) THEN
     194               
     195c      PRINT*,'DEBUT CLOUD'     
    293196c     On remet tout le RM liq dans la partie gaz
    294197c     !!! On reforme un nuage à chaque fois !!!
    295          
    296       mrtwv=trac(ilon,ilev,i_h2o) + trac(ilon,ilev,i_h2oliq)
    297       mrtsa=trac(ilon,ilev,i_h2so4) + trac(ilon,ilev,i_h2so4liq)
    298       mrwv=mrtwv
    299       mrsa=mrtsa
    300      
    301 
    302 c     !!! Remise a zero !!!
    303         W_H2SO4(ilon,ilev)=0.0d0
    304         W_H2O(ilon,ilev)=0.d0
    305         rho(ilon,ilev)=0.0d0
    306         NBRTOT_droplet(ilon,ilev)=0.d0
    307         satps_sa=0.d0
    308         ps_sa=0.d0
    309        
    310 c       pression partielle H2O       
    311       ppwv=pplev(ilon,ilev) * mrwv
    312 
    313 c     Pression saturante de vapeur d'eau, tirée du code d'Anni
    314       psatwv=EXP(77.344913 - 7235.4247/temp(ilon,ilev)
    315      & - 8.2*DLOG(temp(ilon,ilev)) + 0.0057113*temp(ilon,ilev))
    316      
    317 c      PRINT*,'DEBUT CALL CLOUD'
    318 
    319 c       Ne pas passer par la routine des nuages si on a des valeurs proches de 0 ?
    320 c       Empeche de foirer en parallèle ?
    321 
    322            
    323       CALL new_cloud_venus(dT_cloud,
    324      e NBRTOT_droplet(ilon,ilev),
    325      e R_MEDIAN(ilon,ilev),STDDEV(ilon,ilev),
    326      e temp(ilon,ilev),pplev(ilon,ilev),
    327      e ppwv,
    328      e mrwv,mrsa,
    329      e ilev,
     198
     199      DO ilev=1, n_lev
     200      DO ilon=1, n_lon         
     201      mrtwv(ilon,ilev)=trac(ilon,ilev,i_h2o) +
     202     &  trac(ilon,ilev,i_h2oliq)
     203      mrtsa(ilon,ilev)=trac(ilon,ilev,i_h2so4) +
     204     &  trac(ilon,ilev,i_h2so4liq)
     205      mrwv(ilon,ilev)=mrtwv(ilon,ilev)
     206      mrsa(ilon,ilev)=mrtsa(ilon,ilev)
     207      ENDDO
     208      ENDDO
     209                   
     210      CALL new_cloud_venus(n_lev, n_lon,
     211     e temp,pplev,
    330212     e mrtwv,mrtsa,
    331      e W_H2SO4(ilon,ilev),
    332      e ps_sa,satps_sa,
    333      e rho(ilon,ilev))
    334            
    335 c      END DO
    336    
     213     e mrwv,mrsa)
     214
    337215c       =========================================               
    338216c       Actualisation des mixing ratio liq et gaz
    … …  
    344222c      PRINT*,'DEBUT ACTUALISATION OUTPUT CLOUD'
    345223c    si tout se passe bien, mrtwv et mrtsa ne changent pas
    346      
    347       trac(ilon,ilev,i_h2o) = mrwv
    348       trac(ilon,ilev,i_h2oliq) = mrtwv - trac(ilon,ilev,i_h2o)
     224      DO ilev=1, n_lev
     225      DO ilon=1, n_lon       
     226      trac(ilon,ilev,i_h2o) = mrwv(ilon,ilev)
     227      trac(ilon,ilev,i_h2oliq) = mrtwv(ilon,ilev) -
     228     &  trac(ilon,ilev,i_h2o)
    349229     
    350       trac(ilon,ilev,i_h2so4) = mrsa
    351       trac(ilon,ilev,i_h2so4liq) = mrtsa - trac(ilon,ilev,i_h2so4)
    352        
    353 c      ENDIF
    354      
    355      
    356       IF (n_lon .EQ. 1) THEN   
    357       WRITE(66,"(i4,','11(e15.8,','))") ilev,temp(ilon,ilev),
    358      & pplev(ilon,ilev),ps_sa,satps_sa,NBRTOT_droplet(ilon,ilev),
    359      & W_H2SO4(ilon,ilev),trac(ilon,ilev,i_h2oliq),
    360      & trac(ilon,ilev,i_h2so4liq),mrwv,mrsa,trac(ilon,ilev,i_so2)
    361       ENDIF
    362 
    363       END DO
     230      trac(ilon,ilev,i_h2so4) = mrsa(ilon,ilev)
     231      trac(ilon,ilev,i_h2so4liq) = mrtsa(ilon,ilev) -
     232     &  trac(ilon,ilev,i_h2so4)
     233      ENDDO
     234      ENDDO
    364235
    365236c       =============================================================
    366237c      PRINT*,'FIN CLOUD'
    367238      ENDIF
    368      
     239           
     240c=============================================================
     241c               CHIMIE: Boucle sur les lon, lat (n_lon)
     242c=============================================================
     243
     244c     AS:
     245c     Ici, la longitude au midi local se deplace vers l'Ouest
     246c     c'est le sens terrestre
     247c     pour Vénus on prend juste l'opposé de la longitude et on a la rotation
     248c     de Vénus et donc le midi local qui se déplace vers l'Est
     249     
     250      lon_sun = (0.5 - gmtime) * 2.0 * RPI
     251      lon_local = lon * RPI/180.0E+0
     252      lat_local = lat * RPI/180.0E+0
     253       
     254      DO ilon=1, n_lon
     255
     256c     calcul sza_local pour obtenir des sza_local > 90, utile pour la chimie
     257      sza_local = acos(cos(lat_local(ilon))*cos(lon_local(ilon))*
     258     & cos(lon_sun) + cos(lat_local(ilon))*sin(lon_local(ilon))
     259     & *sin(lon_sun))* 180.0E+0/RPI
     260     
     261c      PRINT*,'sza_local :', sza_local     
     262   
    369263      IF (ok_chem) THEN
    370 c      PRINT*,"vmr SO2 ht atmo: ",trac(1,50,i_so2)
    371264c      PRINT*,'DEBUT CHEMISTRY'
    372265c       =============================================================
    … …  
    382275c       =============================================================
    383276c      PRINT*,'FIN CHEMISTRY'
    384 c      PRINT*,"vmr SO2 ht atmo: ",trac(1,50,i_so2)
    385      
     277   
    386278        END IF
    387279
    … …  
    391283c       =============================================================
    392284        DO iq=1,nqmax
    393                 trac(:,:,iq)=trac(:,:,iq)*M_tr(iq)/RMD
     285c               trac(:,:,iq)=trac(:,:,iq)*M_tr(iq)/RMD
     286                trac(:,:,iq)=trac(:,:,iq)*M_tr(iq)/mmean(:,:)
     287
    394288        END DO
    395289c       =============================================================   
    396 
    397 c      PRINT*,'FIN PHYTRAC'
     290C      PRINT*,'FIN PHYTRAC'
    398291      RETURN
    399292      END

  • trunk/LMDZ.VENUS/libf/phyvenus/printflag.F

    r815 r1442  
    123123
    124124 12    FORMAT(2x,'*****  Nb d appels /jour des routines de rayonn. = ' ,
    125      , i4,6x,' *****')
     125     , i5,6x,' *****')
    126126
    127127 13    FORMAT(2x,'$$$$$$$$   Attention !!  cycle_diurne  different  sur',

  • trunk/LMDZ.VENUS/libf/phyvenus/radlwsw.F

    r1310 r1442  
    179179       
    180180       ips0=0
     181       if (nbpsve(lat).gt.1) then
    181182       do ips=1,nbpsve(lat)-1
    182183         if (  (psurfve(ips,lat).ge.paprs(j,1))
    … …  
    189190         endif
    190191       enddo
     192       else            ! Only one ps, no interpolation
     193        ips0=1
     194       endif
    191195       isza0=0
    192196       if (nbszave(lat).gt.1) then
    … …  
    205209       endif
    206210       
     211c -------- Probleme aux bords
     212       if ((ips0.eq.0).and.(psurfve(1,lat).gt.paprs(j,1))) then
     213              ips0  = 1
     214              print*,'Extrapolation! ig=',j,'  ips0=',ips0
     215              factp = (paprs(j,1)         -psurfve(ips0,lat))
     216     .               /(psurfve(ips0+1,lat)-psurfve(ips0,lat))
     217       endif
     218       if ((ips0.eq.0).and.(psurfve(nbpsve(lat),lat).le.paprs(j,1)))
     219     .   then
     220              ips0  = nbpsve(lat)-1
     221              print*,'Extrapolation! ig=',j,'  ips0=',ips0
     222              factp = (paprs(j,1)         -psurfve(ips0,lat))
     223     .               /(psurfve(ips0+1,lat)-psurfve(ips0,lat))
     224       endif
     225c ---------
     226
    207227       if ((ips0.eq.0).or.(isza0.eq.0)) then
    208228         write(*,*) 'Finding the right matrix in radlwsw'
    … …  
    254274c---------
    255275      znivs=zzlev(j,:)
     276c      CALL SW_venus_ve_1Dglobave(zrmu0, zfract,   ! pour moy globale
    256277c      CALL SW_venus_ve(zrmu0, zfract,
    257278c     S        PPB,temp,znivs,
    … …  
    259280c     S        ztopsw,zsolsw,ZFSNET)
    260281
     282c      CALL SW_venus_cl_1Dglobave(zrmu0, zfract,   ! pour moy globale
     283c      CALL SW_venus_cl(zrmu0, zfract,
     284c      CALL SW_venus_dc_1Dglobave(zrmu0, zfract,   ! pour moy globale
    261285      CALL SW_venus_dc(zrmu0, zfract,
    262286     S        PPB,temp,

  • trunk/LMDZ.VENUS/libf/phyvenus/sw_venus_dc.F

    r1310 r1442  
    6868      real   zldn                    ! downward IR flux (W/m**2) ?
    6969      real   zlup                    !   upward IR flux (W/m**2) ?
    70       real   zsolnet(nldc+1)         ! for testing mean net solar flux in DC
    7170      character*22 nullchar
    7271      real   sza0,factsza,factflux
    7372      logical firstcall
    7473      data    firstcall/.true./
    75       REAL,save,allocatable :: zsolVE(:) ! net solar flux at ppb levels, fichiers VE
    7674      save   solza,zsnet,presdc,tempdc,altdc
    7775      save   firstcall
    … …  
    8280
    8381      if (firstcall) then
    84        allocate(zsolVE(klevp1))
    8582
    8683       open(11,file='dataDCrisp.dat')
    … …  
    111108       close(11)
    112109
    113 c ----------- TEST ------------
    114 c      Fichiers de Vincent
    115 c -----------------------------
    116 c      open(12,file='flux_vis_dcGCM.txt')
    117 c      read(12,*) nullchar
    118 c
    119 c       do j=1,klev+1
    120 c          read(12,*) zlup,zldn,zsolVE(j)
    121 c       enddo
    122 c       
    123 c      close(12)
    124 c -----------------------------
    125 c --------  FIN TEST ----------
    126      
    127110       firstcall=.false.
    128111      endif
    129 
    130 c ----------- TEST ------------
    131 c      Moyenne planetaire
    132 c -----------------------------
    133 c     do j=1,nldc
    134 c  ---
    135 c       zsolnet(j) = zsnet(j,1)*0.5*
    136 c    .             sin(solza(1)*RPI/180.)*solza(2)*RPI/180./2.
    137 c       do nsza=2,nszadc-1
    138 c       zsolnet(j) = zsolnet(j)+zsnet(j,nsza)*0.5*
    139 c    .             sin(solza(nsza)*RPI/180.)*
    140 c    .             (solza(nsza+1)-solza(nsza-1))*RPI/180./2.
    141 c       enddo
    142 c       zsolnet(j) = zsolnet(j)+zsdn(j,nszadc)*0.5*
    143 c    .             sin(solza(nszadc)*RPI/180.)*
    144 c    .             (90.-solza(nszadc-1))*RPI/180./2.
    145 c  ---
    146 c       zsolnet(j) = 0.0
    147 c       do nsza=1,nszadc-1
    148 c       zsolnet(j) = zsolnet(j)+(zsnet(j,nsza  )
    149 c    .                          +zsnet(j,nsza+1))*0.5*
    150 c    .             (cos(solza(nsza  )*RPI/180.)-
    151 c    .              cos(solza(nsza+1)*RPI/180.) )
    152 c       enddo
    153 c       zsolnet(j) = zsolnet(j)+zsnet(j,nszadc)*0.25*
    154 c      .             cos(solza(nszadc)*RPI/180.)
    155 c  ---
    156 c       print*,j,altdc(j),zsolnet(j)
    157 c     enddo
    158 c     stop
    159 c -----------------------------
    160 c --------  FIN TEST ----------
    161112
    162113c --------------------------------------
    … …  
    212163      enddo
    213164
    214 c ----------- TEST ------------
    215 c      Fichiers de Vincent
    216 c -----------------------------
    217 c     do j=1,klev+1
    218 c       ZFSNET(j)=zsolVE(j)
    219 c     enddo
    220 c -----------------------------
    221 c --------  FIN TEST ----------
    222 
    223165      PTOPSW = ZFSNET(klev+1)
    224166      PSOLSW = ZFSNET(1)

  • trunk/LMDZ.VENUS/libf/phyvenus/write_histins.h

    r1310 r1442  
    1616      call histwrite_phy(nid_ins,.false.,"psol",itau_w,paprs(:,1))
    1717c     call histwrite_phy(nid_ins,.false.,"ue",itau_w,ue)
    18 c VENUS: regardee a l'envers!!!!!!!!!!!!!!!
     18c VENUS: regardee a l' envers!!!!!!!!!!!!!!!
    1919c     call histwrite_phy(nid_ins,.false.,"ve",itau_w,-1.*ve)
    2020c     call histwrite_phy(nid_ins,.false.,"cdragh",itau_w,cdragh)
    … …  
    3232      call histwrite_phy(nid_ins,.false.,"geop",itau_w,zphi)
    3333      call histwrite_phy(nid_ins,.false.,"vitu",itau_w,u_seri)
    34 c VENUS: regardee a l'envers!!!!!!!!!!!!!!!
     34c VENUS: regardee a l' envers !!!!!!!!!!!!!!!
    3535      call histwrite_phy(nid_ins,.false.,"vitv",itau_w,-1.*v_seri)
    3636      call histwrite_phy(nid_ins,.false.,"vitw",itau_w,omega)
    … …  
    4242c     call histwrite_phy(nid_ins,.false.,"Kz",itau_w,ycoefh)
    4343
    44 c plusieurs traceurs
    45        IF (iflag_trac.eq.1) THEN
     44c plusieurs traceurs  !!!outputs in [vmr]
     45       IF (ok_chem) THEN
    4646         DO iq=1,nqmax
    47        call histwrite_phy(nid_ins,.false.,tname(iq),itau_w,qx(:,:,iq))
     47       call histwrite_phy(nid_ins,.false.,tname(iq),itau_w,qx(:,:,iq)*
     48     &                    mmean(:,:)/M_tr(iq))
    4849         ENDDO
    4950       ENDIF
     51     
     52       call histwrite_phy(nid_ins,.false.,"tops",itau_w,topsw)
     53     
     54       IF (ok_cloud) THEN
     55       
     56       IF (nb_mode.GE.1) THEN
     57      call histwrite_phy(nid_ins,.false.,"NBRTOTm1",itau_w,
     58     & NBRTOT(:,:,1))
     59     
     60c      call histwrite_phy(nid_ins,.false.,"R_MEDIANm1",itau_w,
     61c     & R_MEDIAN(:,:,1))
     62     
     63c      call histwrite_phy(nid_ins,.false.,"STDDEVm1",itau_w,
     64c     & STDDEV(:,:,1))
     65       
     66       IF (nb_mode.GE.2) THEN
     67      call histwrite_phy(nid_ins,.false.,"NBRTOTm2",itau_w,
     68     & NBRTOT(:,:,2))
     69     
     70c      call histwrite_phy(nid_ins,.false.,"R_MEDIANm2",itau_w,
     71c     & R_MEDIAN(:,:,2))
     72     
     73c      call histwrite_phy(nid_ins,.false.,"STDDEVm2",itau_w,
     74c     & STDDEV(:,:,2))
     75         
     76       IF (nb_mode.GE.3) THEN
     77      call histwrite_phy(nid_ins,.false.,"NBRTOTm3",itau_w,
     78     & NBRTOT(:,:,3))
     79     
     80c      call histwrite_phy(nid_ins,.false.,"R_MEDIANm3",itau_w,
     81c     & R_MEDIAN(:,:,3))
     82     
     83c      call histwrite_phy(nid_ins,.false.,"STDDEVm3",itau_w,
     84c     & STDDEV(:,:,3))
    5085
    51       call histwrite_phy(nid_ins,.false.,"tops",itau_w,topsw)
    52 
    53       if (ok_cloud) THEN
    54        call histwrite_phy(nid_ins,.false.,"NBRTOT",itau_w,NBRTOT)
    55        call histwrite_phy(nid_ins,.false.,"WH2SO4",itau_w,WH2SO4)
    56        call histwrite_phy(nid_ins,.false.,"R_MEDIAN",itau_w,R_MEDIAN)
    57        call histwrite_phy(nid_ins,.false.,"STDDEV",itau_w,STDDEV)
    58        call histwrite_phy(nid_ins,.false.,"rho_droplet",
    59      &                              itau_w,rho_droplet)
    60       endif
    61 
    62       if (ok_sedim) THEN     
    63        call histwrite_phy(nid_ins,.false.,"d_tr_sed_H2SO4",
    64      &                              itau_w,d_tr_sed(:,:,1))
    65        call histwrite_phy(nid_ins,.false.,"d_tr_sed_H2O",
    66      &                              itau_w,d_tr_sed(:,:,2))
    67        call histwrite_phy(nid_ins,.false.,"F_sedim",itau_w,Fsedim)
    68       endif           
    69 
     86       ENDIF
     87       ENDIF
     88       ENDIF
     89             
     90      call histwrite_phy(nid_ins,.false.,"WH2SO4",itau_w,WH2SO4)
     91     
     92      call histwrite_phy(nid_ins,.false.,"rho_droplet",itau_w,
     93     & rho_droplet)
     94                ENDIF
     95       IF (ok_sedim) THEN
     96     
     97      call histwrite_phy(nid_ins,.false.,"d_tr_sed_H2SO4",itau_w,
     98     & d_tr_sed(:,:,1))     
     99      call histwrite_phy(nid_ins,.false.,"d_tr_sed_H2O",itau_w,
     100     & d_tr_sed(:,:,2))
     101     
     102      call histwrite_phy(nid_ins,.false.,"F_sedim",itau_w,Fsedim)
     103                ENDIF             
    70104      ENDIF !lev_histins.GE.2
    71105
    … …  
    103137c en K/s     
    104138      call histwrite_phy(nid_ins,.false.,"dtajs",itau_w,d_t_ajs)
    105 c en K/s     
    106       call histwrite_phy(nid_ins,.false.,"dtswr",itau_w,dtsw)
    107 c en K/s     
    108       call histwrite_phy(nid_ins,.false.,"dtlwr",itau_w,dtlw)
     139c K/day ==> K/s
     140      call histwrite_phy(nid_ins,.false.,"dtswr",itau_w,heat/RDAY)
     141c K/day ==> K/s     
     142      call histwrite_phy(nid_ins,.false.,"dtlwr",itau_w,-1.*cool/RDAY)
    109143c en K/s     
    110144c     call histwrite_phy(nid_ins,.false.,"dtec",itau_w,d_t_ec)
    … …  
    116150      call histwrite_phy(nid_ins,.false.,"dugwno",itau_w,d_u_hin)
    117151c en (m/s)/s     
    118 c VENUS: regardee a l'envers!!!!!!!!!!!!!!!
     152c VENUS: regardee a l envers!!!!!!!!!!!!!!!
    119153c     call histwrite_phy(nid_ins,.false.,"dvvdf",itau_w,-1.*d_v_vdf)
    120154
Note: See TracChangeset for help on using the changeset viewer.