Changeset 1894


Ignore:
Timestamp:
Jan 15, 2018, 12:08:11 PM (7 years ago)
Author:
jvatant
Message:

Making chemistry more flexible - step 3.5
+ Update phyredem and phyetat0 ( with a chem_settings.F90 init routine )
+ Finish the handling of upper chem fields by their names everywhere
( with hardcoded cnames and mmol moved from tracer_h to comchem_h )
--JVO

Location:
trunk/LMDZ.TITAN
Files:
1 added
9 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.TITAN/README

    r1893 r1894  
    13431343Big modifs of the tracer gestion/init in the physiq with a new query by names (see tracer_h )
    13441344
    1345 == 20/12/2017 - ... : r1871-86-87-91 ... == JVO
     1345== 20/12/2017 - ... : r1871-86-87-91-94 ... == JVO
    13461346Management of the chemistry within startfi. Open the way to :
    13471347 1) run with chemistry in another resolution than 32x48 !
    … …  
    13541354+ Added a comchem_h.F90 module for all the stuff related to chemistry in the GCM and
    13551355 specific comchem_newstart_h.F90 for the chemistry management in newstart
     1356+ Hardcoded names and mmol for chemistry moved from tracer_h to comchem_h
    13561357+ In newstart we calculate the pressure grid above GCM top using Vervack profile
    13571358with the introduction of gr_kim_vervack.F90 routine
     1359+ For initialisation and loading of chemistry fields in phyetat0 -> chem_settings.F90
    13581360+ ...
    13591361

  • trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/comchem_newstart_h.F90

    r1892 r1894  
    2525  REAL,ALLOCATABLE :: ykim_upoldS(:,:,:,:)
    2626 
    27  
    28   CONTAINS
    29  
    30  
    31   SUBROUTINE read_startarch_kim(nid,start,count)
    32  
    33     ! Purpose : * Read by ther names, upper chemsitry fields present
    34     !             in start_archive.nc as physical variables
    35     !           * H_up field is read before, as the 1st one 
    36     !             we perform sanity check on it
    37     !           * We assume a given order of the 44 tracers (cf comchem_h)
    38  
    39     IMPLICIT NONE
    40    
    41     include "netcdf.inc"
    42    
    43     INTEGER, INTENT(IN)               :: nid ! "start_archive.nc" NetCDF file ID
    44     INTEGER, DIMENSION(4), INTENT(IN) :: start, count
    45    
    46     INTEGER :: varid, nvarid, ierr
    47    
    48     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    49    
    50     ierr=NF_INQ_VARID(nid,"H2_up",nvarid)
    51     IF (ierr .NE. NF_NOERR) THEN
    52       PRINT*, "lect_start_archive: Le champ <H2_up> est absent..."
    53       CALL abort
    54     ENDIF
    55 #ifdef NC_DOUBLE
    56     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(2,:,:,:))
    57 #else
    58     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(2,:,:,:))
    59 #endif
    60     IF (ierr .NE. NF_NOERR) THEN
    61        PRINT*, "lect_start_archive: Lecture echouee pour <H2_up>"
    62        CALL abort
    63     ENDIF
    64      
    65     ! --------------------------------
    66    
    67     ierr=NF_INQ_VARID(nid,"CH_up",nvarid)
    68     IF (ierr .NE. NF_NOERR) THEN
    69       PRINT*, "lect_start_archive: Le champ <CH_up> est absent..."
    70       CALL abort
    71     ENDIF
    72 #ifdef NC_DOUBLE
    73     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(3,:,:,:))
    74 #else
    75     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(3,:,:,:))
    76 #endif
    77     IF (ierr .NE. NF_NOERR) THEN
    78        PRINT*, "lect_start_archive: Lecture echouee pour <CH_up>"
    79        CALL abort
    80     ENDIF
    81      
    82     ! --------------------------------
    83    
    84     ierr=NF_INQ_VARID(nid,"CH2s_up",nvarid)
    85     IF (ierr .NE. NF_NOERR) THEN
    86       PRINT*, "lect_start_archive: Le champ <CH2s_up> est absent..."
    87       CALL abort
    88     ENDIF
    89 #ifdef NC_DOUBLE
    90     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(4,:,:,:))
    91 #else
    92     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(4,:,:,:))
    93 #endif
    94     IF (ierr .NE. NF_NOERR) THEN
    95        PRINT*, "lect_start_archive: Lecture echouee pour <CH2s_up>"
    96        CALL abort
    97     ENDIF
    98      
    99     ! --------------------------------
    100    
    101     ierr=NF_INQ_VARID(nid,"CH2_up",nvarid)
    102     IF (ierr .NE. NF_NOERR) THEN
    103       PRINT*, "lect_start_archive: Le champ <CH2_up> est absent..."
    104       CALL abort
    105     ENDIF
    106 #ifdef NC_DOUBLE
    107     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(5,:,:,:))
    108 #else
    109     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(5,:,:,:))
    110 #endif
    111     IF (ierr .NE. NF_NOERR) THEN
    112        PRINT*, "lect_start_archive: Lecture echouee pour <CH2_up>"
    113        CALL abort
    114     ENDIF
    115      
    116     ! --------------------------------
    117    
    118     ierr=NF_INQ_VARID(nid,"CH3_up",nvarid)
    119     IF (ierr .NE. NF_NOERR) THEN
    120       PRINT*, "lect_start_archive: Le champ <CH3_up> est absent..."
    121       CALL abort
    122     ENDIF
    123 #ifdef NC_DOUBLE
    124     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(6,:,:,:))
    125 #else
    126     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(6,:,:,:))
    127 #endif
    128     IF (ierr .NE. NF_NOERR) THEN
    129        PRINT*, "lect_start_archive: Lecture echouee pour <CH3_up>"
    130        CALL abort
    131     ENDIF
    132      
    133     ! --------------------------------
    134    
    135     ierr=NF_INQ_VARID(nid,"CH4_up",nvarid)
    136     IF (ierr .NE. NF_NOERR) THEN
    137       PRINT*, "lect_start_archive: Le champ <CH4_up> est absent..."
    138       CALL abort
    139     ENDIF
    140 #ifdef NC_DOUBLE
    141     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(7,:,:,:))
    142 #else
    143     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(7,:,:,:))
    144 #endif
    145     IF (ierr .NE. NF_NOERR) THEN
    146        PRINT*, "lect_start_archive: Lecture echouee pour <CH4_up>"
    147        CALL abort
    148     ENDIF
    149      
    150     ! --------------------------------
    151    
    152     ierr=NF_INQ_VARID(nid,"C2_up",nvarid)
    153     IF (ierr .NE. NF_NOERR) THEN
    154       PRINT*, "lect_start_archive: Le champ <C2_up> est absent..."
    155       CALL abort
    156     ENDIF
    157 #ifdef NC_DOUBLE
    158     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(8,:,:,:))
    159 #else
    160     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(8,:,:,:))
    161 #endif
    162     IF (ierr .NE. NF_NOERR) THEN
    163        PRINT*, "lect_start_archive: Lecture echouee pour <C2_up>"
    164        CALL abort
    165     ENDIF
    166      
    167     ! --------------------------------
    168    
    169     ierr=NF_INQ_VARID(nid,"C2H_up",nvarid)
    170     IF (ierr .NE. NF_NOERR) THEN
    171       PRINT*, "lect_start_archive: Le champ <C2H_up> est absent..."
    172       CALL abort
    173     ENDIF
    174 #ifdef NC_DOUBLE
    175     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(9,:,:,:))
    176 #else
    177     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(9,:,:,:))
    178 #endif
    179     IF (ierr .NE. NF_NOERR) THEN
    180        PRINT*, "lect_start_archive: Lecture echouee pour <C2H_up>"
    181        CALL abort
    182     ENDIF
    183      
    184     ! --------------------------------
    185    
    186     ierr=NF_INQ_VARID(nid,"C2H2_up",nvarid)
    187     IF (ierr .NE. NF_NOERR) THEN
    188       PRINT*, "lect_start_archive: Le champ <C2H2_up> est absent..."
    189       CALL abort
    190     ENDIF
    191 #ifdef NC_DOUBLE
    192     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(10,:,:,:))
    193 #else
    194     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(10,:,:,:))
    195 #endif
    196     IF (ierr .NE. NF_NOERR) THEN
    197        PRINT*, "lect_start_archive: Lecture echouee pour <C2H2_up>"
    198        CALL abort
    199     ENDIF
    200      
    201     ! --------------------------------
    202    
    203     ierr=NF_INQ_VARID(nid,"C2H3_up",nvarid)
    204     IF (ierr .NE. NF_NOERR) THEN
    205       PRINT*, "lect_start_archive: Le champ <C2H3_up> est absent..."
    206       CALL abort
    207     ENDIF
    208 #ifdef NC_DOUBLE
    209     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(11,:,:,:))
    210 #else
    211     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(11,:,:,:))
    212 #endif
    213     IF (ierr .NE. NF_NOERR) THEN
    214        PRINT*, "lect_start_archive: Lecture echouee pour <C2H3_up>"
    215        CALL abort
    216     ENDIF
    217      
    218     ! --------------------------------
    219    
    220     ierr=NF_INQ_VARID(nid,"C2H4_up",nvarid)
    221     IF (ierr .NE. NF_NOERR) THEN
    222       PRINT*, "lect_start_archive: Le champ <C2H4_up> est absent..."
    223       CALL abort
    224     ENDIF
    225 #ifdef NC_DOUBLE
    226     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(12,:,:,:))
    227 #else
    228     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(12,:,:,:))
    229 #endif
    230     IF (ierr .NE. NF_NOERR) THEN
    231        PRINT*, "lect_start_archive: Lecture echouee pour <C2H4_up>"
    232        CALL abort
    233     ENDIF
    234      
    235     ! --------------------------------
    236    
    237     ierr=NF_INQ_VARID(nid,"C2H5_up",nvarid)
    238     IF (ierr .NE. NF_NOERR) THEN
    239       PRINT*, "lect_start_archive: Le champ <C2H5_up> est absent..."
    240       CALL abort
    241     ENDIF
    242 #ifdef NC_DOUBLE
    243     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(13,:,:,:))
    244 #else
    245     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(13,:,:,:))
    246 #endif
    247     IF (ierr .NE. NF_NOERR) THEN
    248        PRINT*, "lect_start_archive: Lecture echouee pour <C2H5_up>"
    249        CALL abort
    250     ENDIF
    251      
    252     ! --------------------------------
    253    
    254     ierr=NF_INQ_VARID(nid,"C2H6_up",nvarid)
    255     IF (ierr .NE. NF_NOERR) THEN
    256       PRINT*, "lect_start_archive: Le champ <C2H6_up> est absent..."
    257       CALL abort
    258     ENDIF
    259 #ifdef NC_DOUBLE
    260     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(14,:,:,:))
    261 #else
    262     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(14,:,:,:))
    263 #endif
    264     IF (ierr .NE. NF_NOERR) THEN
    265        PRINT*, "lect_start_archive: Lecture echouee pour <C2H6_up>"
    266        CALL abort
    267     ENDIF
    268      
    269     ! --------------------------------
    270    
    271     ierr=NF_INQ_VARID(nid,"C3H3_up",nvarid)
    272     IF (ierr .NE. NF_NOERR) THEN
    273       PRINT*, "lect_start_archive: Le champ <C3H3_up> est absent..."
    274       CALL abort
    275     ENDIF
    276 #ifdef NC_DOUBLE
    277     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(15,:,:,:))
    278 #else
    279     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(15,:,:,:))
    280 #endif
    281     IF (ierr .NE. NF_NOERR) THEN
    282        PRINT*, "lect_start_archive: Lecture echouee pour <C3H3_up>"
    283        CALL abort
    284     ENDIF
    285      
    286     ! --------------------------------
    287    
    288     ierr=NF_INQ_VARID(nid,"C3H5_up",nvarid)
    289     IF (ierr .NE. NF_NOERR) THEN
    290       PRINT*, "lect_start_archive: Le champ <C3H5_up> est absent..."
    291       CALL abort
    292     ENDIF
    293 #ifdef NC_DOUBLE
    294     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(16,:,:,:))
    295 #else
    296     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(16,:,:,:))
    297 #endif
    298     IF (ierr .NE. NF_NOERR) THEN
    299        PRINT*, "lect_start_archive: Lecture echouee pour <C3H5_up>"
    300        CALL abort
    301     ENDIF
    302      
    303     ! --------------------------------
    304    
    305     ierr=NF_INQ_VARID(nid,"C3H6_up",nvarid)
    306     IF (ierr .NE. NF_NOERR) THEN
    307       PRINT*, "lect_start_archive: Le champ <C3H6_up> est absent..."
    308       CALL abort
    309     ENDIF
    310 #ifdef NC_DOUBLE
    311     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(17,:,:,:))
    312 #else
    313     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(17,:,:,:))
    314 #endif
    315     IF (ierr .NE. NF_NOERR) THEN
    316        PRINT*, "lect_start_archive: Lecture echouee pour <C3H6_up>"
    317        CALL abort
    318     ENDIF
    319      
    320     ! --------------------------------
    321    
    322     ierr=NF_INQ_VARID(nid,"C3H7_up",nvarid)
    323     IF (ierr .NE. NF_NOERR) THEN
    324       PRINT*, "lect_start_archive: Le champ <C3H7_up> est absent..."
    325       CALL abort
    326     ENDIF
    327 #ifdef NC_DOUBLE
    328     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(18,:,:,:))
    329 #else
    330     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(18,:,:,:))
    331 #endif
    332     IF (ierr .NE. NF_NOERR) THEN
    333        PRINT*, "lect_start_archive: Lecture echouee pour <C3H7_up>"
    334        CALL abort
    335     ENDIF
    336      
    337     ! --------------------------------
    338    
    339     ierr=NF_INQ_VARID(nid,"C4H_up",nvarid)
    340     IF (ierr .NE. NF_NOERR) THEN
    341       PRINT*, "lect_start_archive: Le champ <C4H_up> est absent..."
    342       CALL abort
    343     ENDIF
    344 #ifdef NC_DOUBLE
    345     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(19,:,:,:))
    346 #else
    347     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(19,:,:,:))
    348 #endif
    349     IF (ierr .NE. NF_NOERR) THEN
    350        PRINT*, "lect_start_archive: Lecture echouee pour <C4H_up>"
    351        CALL abort
    352     ENDIF
    353      
    354     ! --------------------------------
    355    
    356     ierr=NF_INQ_VARID(nid,"C4H3_up",nvarid)
    357     IF (ierr .NE. NF_NOERR) THEN
    358       PRINT*, "lect_start_archive: Le champ <C4H3_up> est absent..."
    359       CALL abort
    360     ENDIF
    361 #ifdef NC_DOUBLE
    362     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(20,:,:,:))
    363 #else
    364     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(20,:,:,:))
    365 #endif
    366     IF (ierr .NE. NF_NOERR) THEN
    367        PRINT*, "lect_start_archive: Lecture echouee pour <C4H3_up>"
    368        CALL abort
    369     ENDIF
    370      
    371     ! --------------------------------
    372    
    373     ierr=NF_INQ_VARID(nid,"C4H4_up",nvarid)
    374     IF (ierr .NE. NF_NOERR) THEN
    375       PRINT*, "lect_start_archive: Le champ <C4H4_up> est absent..."
    376       CALL abort
    377     ENDIF
    378 #ifdef NC_DOUBLE
    379     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(21,:,:,:))
    380 #else
    381     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(21,:,:,:))
    382 #endif
    383     IF (ierr .NE. NF_NOERR) THEN
    384        PRINT*, "lect_start_archive: Lecture echouee pour <C4H4_up>"
    385        CALL abort
    386     ENDIF
    387      
    388     ! --------------------------------
    389    
    390     ierr=NF_INQ_VARID(nid,"C4H2s_up",nvarid)
    391     IF (ierr .NE. NF_NOERR) THEN
    392       PRINT*, "lect_start_archive: Le champ <C4H2s_up> est absent..."
    393       CALL abort
    394     ENDIF
    395 #ifdef NC_DOUBLE
    396     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(22,:,:,:))
    397 #else
    398     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(22,:,:,:))
    399 #endif
    400     IF (ierr .NE. NF_NOERR) THEN
    401        PRINT*, "lect_start_archive: Lecture echouee pour <C4H2s_up>"
    402        CALL abort
    403     ENDIF
    404      
    405     ! --------------------------------
    406    
    407     ierr=NF_INQ_VARID(nid,"CH2CCH2_up",nvarid)
    408     IF (ierr .NE. NF_NOERR) THEN
    409       PRINT*, "lect_start_archive: Le champ <CH2CCH2_up> est absent..."
    410       CALL abort
    411     ENDIF
    412 #ifdef NC_DOUBLE
    413     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(23,:,:,:))
    414 #else
    415     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(23,:,:,:))
    416 #endif
    417     IF (ierr .NE. NF_NOERR) THEN
    418        PRINT*, "lect_start_archive: Lecture echouee pour <CH2CCH2_up>"
    419        CALL abort
    420     ENDIF
    421      
    422     ! --------------------------------
    423    
    424     ierr=NF_INQ_VARID(nid,"CH3CCH_up",nvarid)
    425     IF (ierr .NE. NF_NOERR) THEN
    426       PRINT*, "lect_start_archive: Le champ <CH3CCH_up> est absent..."
    427       CALL abort
    428     ENDIF
    429 #ifdef NC_DOUBLE
    430     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(24,:,:,:))
    431 #else
    432     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(24,:,:,:))
    433 #endif
    434     IF (ierr .NE. NF_NOERR) THEN
    435        PRINT*, "lect_start_archive: Lecture echouee pour <CH3CCH_up>"
    436        CALL abort
    437     ENDIF
    438      
    439     ! --------------------------------
    440    
    441     ierr=NF_INQ_VARID(nid,"C3H8_up",nvarid)
    442     IF (ierr .NE. NF_NOERR) THEN
    443       PRINT*, "lect_start_archive: Le champ <C3H8_up> est absent..."
    444       CALL abort
    445     ENDIF
    446 #ifdef NC_DOUBLE
    447     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(25,:,:,:))
    448 #else
    449     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(25,:,:,:))
    450 #endif
    451     IF (ierr .NE. NF_NOERR) THEN
    452        PRINT*, "lect_start_archive: Lecture echouee pour <C3H8_up>"
    453        CALL abort
    454     ENDIF
    455      
    456     ! --------------------------------
    457    
    458     ierr=NF_INQ_VARID(nid,"C4H2_up",nvarid)
    459     IF (ierr .NE. NF_NOERR) THEN
    460       PRINT*, "lect_start_archive: Le champ <C4H2_up> est absent..."
    461       CALL abort
    462     ENDIF
    463 #ifdef NC_DOUBLE
    464     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(26,:,:,:))
    465 #else
    466     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(26,:,:,:))
    467 #endif
    468     IF (ierr .NE. NF_NOERR) THEN
    469        PRINT*, "lect_start_archive: Lecture echouee pour <C4H2_up>"
    470        CALL abort
    471     ENDIF
    472      
    473     ! --------------------------------
    474    
    475     ierr=NF_INQ_VARID(nid,"C4H6_up",nvarid)
    476     IF (ierr .NE. NF_NOERR) THEN
    477       PRINT*, "lect_start_archive: Le champ <C4H6_up> est absent..."
    478       CALL abort
    479     ENDIF
    480 #ifdef NC_DOUBLE
    481     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(27,:,:,:))
    482 #else
    483     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(27,:,:,:))
    484 #endif
    485     IF (ierr .NE. NF_NOERR) THEN
    486        PRINT*, "lect_start_archive: Lecture echouee pour <C4H6_up>"
    487        CALL abort
    488     ENDIF
    489      
    490     ! --------------------------------
    491    
    492     ierr=NF_INQ_VARID(nid,"C4H10_up",nvarid)
    493     IF (ierr .NE. NF_NOERR) THEN
    494       PRINT*, "lect_start_archive: Le champ <C4H10_up> est absent..."
    495       CALL abort
    496     ENDIF
    497 #ifdef NC_DOUBLE
    498     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(28,:,:,:))
    499 #else
    500     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(28,:,:,:))
    501 #endif
    502     IF (ierr .NE. NF_NOERR) THEN
    503        PRINT*, "lect_start_archive: Lecture echouee pour <C4H10_up>"
    504        CALL abort
    505     ENDIF
    506      
    507     ! --------------------------------
    508    
    509     ierr=NF_INQ_VARID(nid,"AC6H6_up",nvarid)
    510     IF (ierr .NE. NF_NOERR) THEN
    511       PRINT*, "lect_start_archive: Le champ <AC6H6_up> est absent..."
    512       CALL abort
    513     ENDIF
    514 #ifdef NC_DOUBLE
    515     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(29,:,:,:))
    516 #else
    517     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(29,:,:,:))
    518 #endif
    519     IF (ierr .NE. NF_NOERR) THEN
    520        PRINT*, "lect_start_archive: Lecture echouee pour <AC6H6_up>"
    521        CALL abort
    522     ENDIF
    523      
    524     ! --------------------------------
    525    
    526     ierr=NF_INQ_VARID(nid,"C3H2_up",nvarid)
    527     IF (ierr .NE. NF_NOERR) THEN
    528       PRINT*, "lect_start_archive: Le champ <C3H2_up> est absent..."
    529       CALL abort
    530     ENDIF
    531 #ifdef NC_DOUBLE
    532     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(30,:,:,:))
    533 #else
    534     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(30,:,:,:))
    535 #endif
    536     IF (ierr .NE. NF_NOERR) THEN
    537        PRINT*, "lect_start_archive: Lecture echouee pour <C3H2_up>"
    538        CALL abort
    539     ENDIF
    540      
    541     ! --------------------------------
    542    
    543     ierr=NF_INQ_VARID(nid,"C4H5_up",nvarid)
    544     IF (ierr .NE. NF_NOERR) THEN
    545       PRINT*, "lect_start_archive: Le champ <C4H5_up> est absent..."
    546       CALL abort
    547     ENDIF
    548 #ifdef NC_DOUBLE
    549     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(31,:,:,:))
    550 #else
    551     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(31,:,:,:))
    552 #endif
    553     IF (ierr .NE. NF_NOERR) THEN
    554        PRINT*, "lect_start_archive: Lecture echouee pour <C4H5_up>"
    555        CALL abort
    556     ENDIF
    557      
    558     ! --------------------------------
    559    
    560     ierr=NF_INQ_VARID(nid,"AC6H5_up",nvarid)
    561     IF (ierr .NE. NF_NOERR) THEN
    562       PRINT*, "lect_start_archive: Le champ <AC6H5_up> est absent..."
    563       CALL abort
    564     ENDIF
    565 #ifdef NC_DOUBLE
    566     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(32,:,:,:))
    567 #else
    568     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(32,:,:,:))
    569 #endif
    570     IF (ierr .NE. NF_NOERR) THEN
    571        PRINT*, "lect_start_archive: Lecture echouee pour <AC6H5_up>"
    572        CALL abort
    573     ENDIF
    574      
    575     ! --------------------------------
    576    
    577     ierr=NF_INQ_VARID(nid,"N2_up",nvarid)
    578     IF (ierr .NE. NF_NOERR) THEN
    579       PRINT*, "lect_start_archive: Le champ <N2_up> est absent..."
    580       CALL abort
    581     ENDIF
    582 #ifdef NC_DOUBLE
    583     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(33,:,:,:))
    584 #else
    585     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(33,:,:,:))
    586 #endif
    587     IF (ierr .NE. NF_NOERR) THEN
    588        PRINT*, "lect_start_archive: Lecture echouee pour <N2_up>"
    589        CALL abort
    590     ENDIF
    591      
    592     ! --------------------------------
    593    
    594     ierr=NF_INQ_VARID(nid,"N4S_up",nvarid)
    595     IF (ierr .NE. NF_NOERR) THEN
    596       PRINT*, "lect_start_archive: Le champ <N4S_up> est absent..."
    597       CALL abort
    598     ENDIF
    599 #ifdef NC_DOUBLE
    600     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(34,:,:,:))
    601 #else
    602     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(34,:,:,:))
    603 #endif
    604     IF (ierr .NE. NF_NOERR) THEN
    605        PRINT*, "lect_start_archive: Lecture echouee pour <N4S_up>"
    606        CALL abort
    607     ENDIF
    608      
    609     ! --------------------------------
    610    
    611     ierr=NF_INQ_VARID(nid,"CN_up",nvarid)
    612     IF (ierr .NE. NF_NOERR) THEN
    613       PRINT*, "lect_start_archive: Le champ <CN_up> est absent..."
    614       CALL abort
    615     ENDIF
    616 #ifdef NC_DOUBLE
    617     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(35,:,:,:))
    618 #else
    619     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(35,:,:,:))
    620 #endif
    621     IF (ierr .NE. NF_NOERR) THEN
    622        PRINT*, "lect_start_archive: Lecture echouee pour <CN_up>"
    623        CALL abort
    624     ENDIF
    625      
    626     ! --------------------------------
    627    
    628     ierr=NF_INQ_VARID(nid,"HCN_up",nvarid)
    629     IF (ierr .NE. NF_NOERR) THEN
    630       PRINT*, "lect_start_archive: Le champ <HCN_up> est absent..."
    631       CALL abort
    632     ENDIF
    633 #ifdef NC_DOUBLE
    634     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(36,:,:,:))
    635 #else
    636     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(36,:,:,:))
    637 #endif
    638     IF (ierr .NE. NF_NOERR) THEN
    639        PRINT*, "lect_start_archive: Lecture echouee pour <HCN_up>"
    640        CALL abort
    641     ENDIF
    642    
    643     ! --------------------------------
    644    
    645     ierr=NF_INQ_VARID(nid,"H2CN_up",nvarid)
    646     IF (ierr .NE. NF_NOERR) THEN
    647       PRINT*, "lect_start_archive: Le champ <H2CN_up> est absent..."
    648       CALL abort
    649     ENDIF
    650 #ifdef NC_DOUBLE
    651     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(37,:,:,:))
    652 #else
    653     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(37,:,:,:))
    654 #endif
    655     IF (ierr .NE. NF_NOERR) THEN
    656        PRINT*, "lect_start_archive: Lecture echouee pour <H2CN_up>"
    657        CALL abort
    658     ENDIF
    659      
    660     ! --------------------------------
    661    
    662     ierr=NF_INQ_VARID(nid,"CHCN_up",nvarid)
    663     IF (ierr .NE. NF_NOERR) THEN
    664       PRINT*, "lect_start_archive: Le champ <CHCN_up> est absent..."
    665       CALL abort
    666     ENDIF
    667 #ifdef NC_DOUBLE
    668     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(38,:,:,:))
    669 #else
    670     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(38,:,:,:))
    671 #endif
    672     IF (ierr .NE. NF_NOERR) THEN
    673        PRINT*, "lect_start_archive: Lecture echouee pour <CHCN_up>"
    674        CALL abort
    675     ENDIF
    676      
    677     ! --------------------------------
    678    
    679     ierr=NF_INQ_VARID(nid,"CH2CN_up",nvarid)
    680     IF (ierr .NE. NF_NOERR) THEN
    681       PRINT*, "lect_start_archive: Le champ <CH2CN_up> est absent..."
    682       CALL abort
    683     ENDIF
    684 #ifdef NC_DOUBLE
    685     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(39,:,:,:))
    686 #else
    687     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(39,:,:,:))
    688 #endif
    689     IF (ierr .NE. NF_NOERR) THEN
    690        PRINT*, "lect_start_archive: Lecture echouee pour <CH2CN_up>"
    691        CALL abort
    692     ENDIF
    693      
    694     ! --------------------------------
    695    
    696     ierr=NF_INQ_VARID(nid,"CH3CN_up",nvarid)
    697     IF (ierr .NE. NF_NOERR) THEN
    698       PRINT*, "lect_start_archive: Le champ <CH3CN_up> est absent..."
    699       CALL abort
    700     ENDIF
    701 #ifdef NC_DOUBLE
    702     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(40,:,:,:))
    703 #else
    704     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(40,:,:,:))
    705 #endif
    706     IF (ierr .NE. NF_NOERR) THEN
    707        PRINT*, "lect_start_archive: Lecture echouee pour <CH3CN_up>"
    708        CALL abort
    709     ENDIF
    710      
    711     ! --------------------------------
    712    
    713     ierr=NF_INQ_VARID(nid,"C3N_up",nvarid)
    714     IF (ierr .NE. NF_NOERR) THEN
    715       PRINT*, "lect_start_archive: Le champ <C3N_up> est absent..."
    716       CALL abort
    717     ENDIF
    718 #ifdef NC_DOUBLE
    719     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(41,:,:,:))
    720 #else
    721     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(41,:,:,:))
    722 #endif
    723     IF (ierr .NE. NF_NOERR) THEN
    724        PRINT*, "lect_start_archive: Lecture echouee pour <C3N_up>"
    725        CALL abort
    726     ENDIF
    727      
    728     ! --------------------------------
    729    
    730     ierr=NF_INQ_VARID(nid,"HC3N_up",nvarid)
    731     IF (ierr .NE. NF_NOERR) THEN
    732       PRINT*, "lect_start_archive: Le champ <HC3N_up> est absent..."
    733       CALL abort
    734     ENDIF
    735 #ifdef NC_DOUBLE
    736     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(42,:,:,:))
    737 #else
    738     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(42,:,:,:))
    739 #endif
    740     IF (ierr .NE. NF_NOERR) THEN
    741        PRINT*, "lect_start_archive: Lecture echouee pour <HC3N_up>"
    742        CALL abort
    743     ENDIF
    744      
    745     ! --------------------------------
    746    
    747     ierr=NF_INQ_VARID(nid,"NCCN_up",nvarid)
    748     IF (ierr .NE. NF_NOERR) THEN
    749       PRINT*, "lect_start_archive: Le champ <NCCN_up> est absent..."
    750       CALL abort
    751     ENDIF
    752 #ifdef NC_DOUBLE
    753     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(43,:,:,:))
    754 #else
    755     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(43,:,:,:))
    756 #endif
    757     IF (ierr .NE. NF_NOERR) THEN
    758        PRINT*, "lect_start_archive: Lecture echouee pour <NCCN_up>"
    759        CALL abort
    760     ENDIF
    761      
    762     ! --------------------------------
    763    
    764     ierr=NF_INQ_VARID(nid,"C4N2_up",nvarid)
    765     IF (ierr .NE. NF_NOERR) THEN
    766       PRINT*, "lect_start_archive: Le champ <C4N2_up> est absent..."
    767       CALL abort
    768     ENDIF
    769 #ifdef NC_DOUBLE
    770     ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,ykim_upoldS(44,:,:,:))
    771 #else
    772     ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,ykim_upoldS(44,:,:,:))
    773 #endif
    774     IF (ierr .NE. NF_NOERR) THEN
    775        PRINT*, "lect_start_archive: Lecture echouee pour <C4N2_up>"
    776        CALL abort
    777     ENDIF
    778      
    779     WRITE(*,*)
    780 
    781   END SUBROUTINE read_startarch_kim
    782  
    78327END MODULE comchem_newstart_h

  • trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/lect_start_archive.F

    r1892 r1894  
    55
    66!      USE surfdat_h
     7      USE comchem_h, only : cnames
    78      USE comchem_newstart_h
    89      USE comsoil_h, ONLY: nsoilmx, layer, mlayer, volcapa, inertiedat
    … …  
    843844      ierr=NF_INQ_VARID(nid,"H_up",nvarid)
    844845     
    845       IF (ierr .NE. NF_NOERR) THEN
     846      IF (ierr .NE. NF_NOERR) THEN ! H_up not found
    846847     
    847848         PRINT*, "lect_start_archive: Le champ <H_up> est absent..."       
    … …  
    856857         ENDIF
    857858         
    858       ELSE
     859      ELSE ! H_up found
    859860     
    860861        IF (.not.callchim) THEN
    … …  
    874875             PRINT*, "lect_start_archive: Lecture echouee pour <H_up>"
    875876             CALL abort
    876           ENDIF         
     877          ENDIF
     878                   
    877879          ! Then read all the others by their name if needed
    878           CALL read_startarch_kim(nid,start,count)             
    879          ENDIF
     880          DO iq=2,44
     881            ierr=NF_INQ_VARID(nid,trim(cnames(iq))//"_up",nvarid)
     882            IF (ierr .NE. NF_NOERR) THEN
     883              PRINT*, "lect_start_archive: Le champ <"
     884     &//trim(cnames(iq))//"_up> est absent..."
     885              CALL abort
     886            ENDIF
     887#ifdef NC_DOUBLE
     888            ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,
     889     &                                ykim_upoldS(iq,:,:,:))
     890#else
     891            ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,
     892     &                              ykim_upoldS(iq,:,:,:))
     893#endif
     894            IF (ierr .NE. NF_NOERR) THEN
     895               PRINT*, "lect_start_archive: Lecture echouee pour <"
     896     &//trim(cnames(iq))//"_up>"
     897               CALL abort
     898            ENDIF
     899          ENDDO
     900     
     901         WRITE(*,*)     
     902         
     903         ENDIF ! if callchim
    880904         
    881905      ENDIF  ! if ierr.ne.nf_no_err

  • trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/newstart.F

    r1892 r1894  
    10851085        WRITE(*,*) " Number of upper chemistry layers =", nlaykim_up
    10861086       
    1087         ! Regriding is then done, if needed
    1088        
    1089         IF (callchim .and. nlaykimold.ne.nlaykim_up) THEN
    1090 
    1091           WRITE(*,*) " Warning, nlaykimold=", nlaykimold
    1092           WRITE(*,*) ' which implies that a vertical regriding on upper 
     1087        IF (callchim) THEN
     1088           
     1089          IF (.NOT.allocated(ykim_up)) THEN
     1090            ALLOCATE(ykim_up(44,ngridmx,nlaykim_up))
     1091          ENDIF
     1092         
     1093          ! Regriding if needed
     1094         
     1095          IF (nlaykimold.ne.nlaykim_up) THEN
     1096
     1097            WRITE(*,*) " Warning, nlaykimold=", nlaykimold
     1098            WRITE(*,*) ' which implies that a vertical regriding on upper 
    10931099     &chemistry fields will be performed.'
    1094           WRITE(*,*)
     1100            WRITE(*,*)
    10951101         
    1096 !          CALL vert_regrid_kim(ngridmx)
     1102!            CALL vert_regrid_kim(ngridmx)
     1103
     1104          ENDIF
    10971105         
    10981106        ENDIF

  • trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/start2archive.F

    r1891 r1894  
    2121      use infotrac, only: infotrac_init, nqtot, tname
    2222      USE comsoil_h
    23       USE comchem_h, only : nlaykim_up, preskim
     23      USE comchem_h, only : cnames, nlaykim_up, preskim, ykim_up
    2424!      USE comgeomfi_h, ONLY: lati, long, area
    2525!      use control_mod
    … …  
    8383c     Added by JVO for Titan specifities
    8484      REAL tankCH4(ngridmx) ! Depth of surface methane tank
    85      
    86       REAL,ALLOCATABLE :: ykim_up(:,:,:)  ! Upper chemistry fields
    8785
    8886c Variable naturelle / grille scalaire
    … …  
    221219     
    222220      ! Allocate other arrays of nlaykim_up size, only if they're present
    223       ! The test is on HCN but could be on any as we assume we can't do incomplete chemistry
    224 
    225       ierr = NF_INQ_VARID(nid1,'HCN_up',varid)
     221      ! The test is on H but could be on any as we assume we can't do incomplete chemistry
     222
     223      ierr = NF_INQ_VARID(nid1,'H_up',varid)
    226224      IF (ierr .NE. NF_NOERR) THEN
    227225        PRINT*, "start2archive: Missing field(s) for upper chemistry ...
    … …  
    268266
    269267
    270 
    271268! load 'controle' array from physics start file
    272269
    … …  
    292289       ENDIF
    293290
    294 ! load upper chemistry pressure grid from physics start file
    295 
    296       ierr = NF_INQ_VARID (nid1, "preskim", varid)
    297       IF (ierr .NE. NF_NOERR) THEN
    298        PRINT*, "start2archive: Le champ <preskim> est absent"
    299        CALL abort
    300       ENDIF
    301 #ifdef NC_DOUBLE
    302        ierr = NF_GET_VAR_DOUBLE(nid1, varid, preskim)
    303 #else
    304       ierr = NF_GET_VAR_REAL(nid1, varid, preskim)
    305 #endif
    306        IF (ierr .NE. NF_NOERR) THEN
    307           PRINT*, "start2archive: Lecture echoue pour <preskim>"
    308           CALL abort
    309        ENDIF
    310 
    311291      ierr = NF_CLOSE(nid1)
    312292
    … …  
    374354c qsurf --> qsurfS
    375355c tankCH4 --> tankCH4S
    376 c + all 44 chemistry fields
     356c ykim_up --> ykim_upS ( 44 upper chemistry fields )
    377357c
    378358c-----------------------------------------------------------------------
    … …  
    388368
    389369      IF (kim) THEN ! NB : fields are in comchem_startarch_h
    390          DO i=1,44
    391            call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,ykim_up(i,:,:),
    392      &                                                 ykim_upS(i,:,:))
     370         DO iq=1,44
     371           call gr_fi_dyn(nlaykim_up,ngridmx,iip1,jjp1,ykim_up(iq,:,:),
     372     &                                                 ykim_upS(iq,:,:))
    393373         ENDDO
    394374      ENDIF
    … …  
    539519c-----------------------------------------------------------------
    540520c Ecriture des champs upper_chemistry
    541 c NB : We assume a given order of the 44 chemistry tracers !!
    542 c ( H=1, H2=2 ..., C4N2=44)
     521c NB : We assume a given order of the 44 chemistry tracers !
     522c ( H=1, H2=2 ..., C4N2=44) -> hardcoded in comchem_h.
    543523c-----------------------------------------------------------------
    544524
    545525      IF (kim) THEN
    546          call write_archive(nid,ntime,'H_up',
    547      .         'H in upper atmosphere','kg/kg',4,ykim_upS(1,:,:))
    548          call write_archive(nid,ntime,'H2_up',
    549      .         'H2 in upper atmosphere','kg/kg',4,ykim_upS(2,:,:))
    550          call write_archive(nid,ntime,'CH_up',
    551      .         'CH in upper atmosphere','kg/kg',4,ykim_upS(3,:,:))
    552          call write_archive(nid,ntime,'CH2s_up',
    553      .         'CH2s in upper atmosphere','kg/kg',4,ykim_upS(4,:,:))
    554          call write_archive(nid,ntime,'CH2_up',
    555      .         'CH2 in upper atmosphere','kg/kg',4,ykim_upS(5,:,:))
    556          call write_archive(nid,ntime,'CH3_up',
    557      .         'CH3 in upper atmosphere','kg/kg',4,ykim_upS(6,:,:))
    558          call write_archive(nid,ntime,'CH4_up',
    559      .         'CH4 in upper atmosphere','kg/kg',4,ykim_upS(7,:,:))
    560          call write_archive(nid,ntime,'C2_up',
    561      .         'C2 in upper atmosphere','kg/kg',4,ykim_upS(8,:,:))
    562          call write_archive(nid,ntime,'C2H_up',
    563      .         'C2H in upper atmosphere','kg/kg',4,ykim_upS(9,:,:))
    564          call write_archive(nid,ntime,'C2H2_up',
    565      .         'C2H2 in upper atmosphere','kg/kg',4,ykim_upS(10,:,:))
    566          call write_archive(nid,ntime,'C2H3_up',
    567      .         'C2H3 in upper atmosphere','kg/kg',4,ykim_upS(11,:,:))
    568          call write_archive(nid,ntime,'C2H4_up',
    569      .         'C2H4 in upper atmosphere','kg/kg',4,ykim_upS(12,:,:))
    570          call write_archive(nid,ntime,'C2H5_up',
    571      .         'C2H5 in upper atmosphere','kg/kg',4,ykim_upS(13,:,:))
    572          call write_archive(nid,ntime,'C2H6_up',
    573      .         'C2H6 in upper atmosphere','kg/kg',4,ykim_upS(14,:,:))
    574          call write_archive(nid,ntime,'C3H3_up',
    575      .         'C3H3 in upper atmosphere','kg/kg',4,ykim_upS(15,:,:))
    576          call write_archive(nid,ntime,'C3H5_up',
    577      .         'C3H5 in upper atmosphere','kg/kg',4,ykim_upS(16,:,:))
    578          call write_archive(nid,ntime,'C3H6_up',
    579      .         'C3H6 in upper atmosphere','kg/kg',4,ykim_upS(17,:,:))
    580          call write_archive(nid,ntime,'C3H7_up',
    581      .         'C3H7 in upper atmosphere','kg/kg',4,ykim_upS(18,:,:))
    582          call write_archive(nid,ntime,'C4H_up',
    583      .         'C4H in upper atmosphere','kg/kg',4,ykim_upS(19,:,:))
    584          call write_archive(nid,ntime,'C4H3_up',
    585      .         'C4H3 in upper atmosphere','kg/kg',4,ykim_upS(20,:,:))
    586          call write_archive(nid,ntime,'C4H4_up',
    587      .         'C4H4 in upper atmosphere','kg/kg',4,ykim_upS(21,:,:))
    588          call write_archive(nid,ntime,'C4H2s_up',
    589      .         'C4H2s in upper atmosphere','kg/kg',4,ykim_upS(22,:,:))
    590          call write_archive(nid,ntime,'CH2CCH2_up',
    591      .         'CH2CCH2 in upper atmosphere','kg/kg',4,ykim_upS(23,:,:))
    592          call write_archive(nid,ntime,'CH3CCH_up',
    593      .         'CH3CCH in upper atmosphere','kg/kg',4,ykim_upS(24,:,:))
    594          call write_archive(nid,ntime,'C3H8_up',
    595      .         'C3H8 in upper atmosphere','kg/kg',4,ykim_upS(25,:,:))
    596          call write_archive(nid,ntime,'C4H2_up',
    597      .         'C4H2 in upper atmosphere','kg/kg',4,ykim_upS(26,:,:))
    598          call write_archive(nid,ntime,'C4H6_up',
    599      .         'C4H6 in upper atmosphere','kg/kg',4,ykim_upS(27,:,:))
    600          call write_archive(nid,ntime,'C4H10_up',
    601      .         'C4H10 in upper atmosphere','kg/kg',4,ykim_upS(28,:,:))
    602          call write_archive(nid,ntime,'AC6H6_up',
    603      .         'AC6H6 in upper atmosphere','kg/kg',4,ykim_upS(29,:,:))
    604          call write_archive(nid,ntime,'C3H2_up',
    605      .         'C3H2 in upper atmosphere','kg/kg',4,ykim_upS(30,:,:))
    606          call write_archive(nid,ntime,'C4H5_up',
    607      .         'C4H5 in upper atmosphere','kg/kg',4,ykim_upS(31,:,:))
    608          call write_archive(nid,ntime,'AC6H5_up',
    609      .         'AC6H5 in upper atmosphere','kg/kg',4,ykim_upS(32,:,:))
    610          call write_archive(nid,ntime,'N2_up',
    611      .         'N2 in upper atmosphere','kg/kg',4,ykim_upS(33,:,:))
    612          call write_archive(nid,ntime,'N4S_up',
    613      .         'N4S in upper atmosphere','kg/kg',4,ykim_upS(34,:,:))
    614          call write_archive(nid,ntime,'CN_up',
    615      .         'CN in upper atmosphere','kg/kg',4,ykim_upS(35,:,:))
    616          call write_archive(nid,ntime,'HCN_up',
    617      .         'HCN in upper atmosphere','kg/kg',4,ykim_upS(36,:,:))
    618          call write_archive(nid,ntime,'H2CN_up',
    619      .         'H2CN in upper atmosphere','kg/kg',4,ykim_upS(37,:,:))
    620          call write_archive(nid,ntime,'CHCN_up',
    621      .         'CHCN in upper atmosphere','kg/kg',4,ykim_upS(38,:,:))
    622          call write_archive(nid,ntime,'CH2CN_up',
    623      .         'CH2CN in upper atmosphere','kg/kg',4,ykim_upS(39,:,:))
    624          call write_archive(nid,ntime,'CH3CN_up',
    625      .         'CH3CN in upper atmosphere','kg/kg',4,ykim_upS(40,:,:))
    626          call write_archive(nid,ntime,'C3N_up',
    627      .         'C3N in upper atmosphere','kg/kg',4,ykim_upS(41,:,:))
    628          call write_archive(nid,ntime,'HC3N_up',
    629      .         'HC3N in upper atmosphere','kg/kg',4,ykim_upS(42,:,:))
    630          call write_archive(nid,ntime,'NCCN_up',
    631      .         'NCCN in upper atmosphere','kg/kg',4,ykim_upS(43,:,:))
    632          call write_archive(nid,ntime,'C4N2_up',
    633      .         'C4N2 in upper atmosphere','kg/kg',4,ykim_upS(44,:,:))
     526        DO iq=1,44
     527          call write_archive(nid,ntime,trim(cnames(iq))//'_up',
     528     .                trim(cnames(iq))//' in upper atmosphere',
     529     .                'kg/kg',4,ykim_upS(iq,:,:))
     530        ENDDO
    634531      ENDIF
    635532

  • trunk/LMDZ.TITAN/libf/phytitan/comchem_h.F90

    r1892 r1894  
    11MODULE comchem_h
    22
    3 ! -----------------------------------------------------------------------
    4 ! Purpose : Stores data relative to upper chemistry in the GCM
    5 ! -------   For newstart there is a specific comchem_newstart_h module.
     3! ----------------------------------------------------------------------------
     4! Purpose : Stores data relative to chemistry in the GCM and upper chemistry
     5! -------
     6!          NB : For newstart there is a specific comchem_newstart_h module.
    67!
    7 ! Author : Jan Vatant d'Ollone (2017)
     8! Author : Jan Vatant d'Ollone (2017-18)
    89! ------
    910!
    … …  
    1415!      N4S, CN, HCN, H2CN, CHCN, CH2CN, CH3CN, C3N, HC3N, NCCN, C4N2
    1516       
    16 ! --------------------------------------------------------------------------
     17! ----------------------------------------------------------------------------
    1718
    1819IMPLICIT NONE 
    19  
    20    INTEGER :: nlaykim_up   ! Number of upper atm. layers for chemistry from GCM top to 4.5E-5 Pa (1300km)
    21    INTEGER :: nlaykim_tot  ! Number of total layers for chemistry from surface to 4.5E-5 Pa (1300km)
     20
     21   !! Hard-coded chemical species for Titan chemistry
     22   CHARACTER(len=10), DIMENSION(44), PARAMETER  :: cnames = &
     23     (/"H         ", "H2        ", "CH        ", "CH2s      ", "CH2       ", "CH3       ", &
     24       "CH4       ", "C2        ", "C2H       ", "C2H2      ", "C2H3      ", "C2H4      ", &
     25       "C2H5      ", "C2H6      ", "C3H3      ", "C3H5      ", "C3H6      ", "C3H7      ", &
     26       "C4H       ", "C4H3      ", "C4H4      ", "C4H2s     ", "CH2CCH2   ", "CH3CCH    ", &
     27       "C3H8      ", "C4H2      ", "C4H6      ", "C4H10     ", "AC6H6     ", "C3H2      ", &
     28       "C4H5      ", "AC6H5     ", "N2        ", "N4S       ", "CN        ", "HCN       ", &
     29       "H2CN      ", "CHCN      ", "CH2CN     ", "CH3CN     ", "C3N       ", "HC3N      ", &
     30       "NCCN      ", "C4N2      "/)
     31   !! Hard-coded chemical species molar mass (g.mol-1), shares the same indexing than cnames.
     32   REAL, DIMENSION(44), PARAMETER               :: cmmol = (/ &
     33       1.01   , 2.0158, 13.02, 14.03, 14.03, 15.03, 16.04  , 24.02, 25.03, 26.04  , 27.05  , &
     34       28.05  , 29.06 , 30.07, 39.06, 41.07, 42.08, 43.09  , 49.05, 51.07, 52.08  , 50.06  , &
     35       40.07  , 40.07 , 44.11, 50.06, 54.09, 58.13, 78.1136, 38.05, 53.07, 77.1136, 28.0134, &
     36       14.01  , 26.02 , 27.04, 28.05, 39.05, 40.04, 41.05  , 50.04, 51.05, 52.04  , 76.1   /)
     37   
     38   ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     39   !  Upper chemistry
     40   ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     41   
     42   INTEGER, SAVE :: nlaykim_up   ! Number of upper atm. layers for chemistry from GCM top to 4.5E-5 Pa (1300km)
     43   INTEGER, SAVE :: nlaykim_tot  ! Number of total layers for chemistry from surface to 4.5E-5 Pa (1300km)
    2244!$OMP_THREADPRIVATE(nlaykim_up,nlay_kim_tot)
    2345
    … …  
    3355!$OMP_THREADPRIVATE(ykim_up)
    3456
     57CONTAINS
     58
     59  SUBROUTINE ini_comchem_h(ngrid)
     60 
     61  IMPLICIT NONE
     62 
     63    include "dimensions.h"
     64 
     65    INTEGER,INTENT(IN) :: ngrid ! number of atmospheric columns
     66 
     67    nlaykim_tot = nlaykim_up + llm
     68 
     69    IF (.NOT.allocated(preskim)) ALLOCATE(preskim(nlaykim_up))
     70    IF (.NOT.allocated(zlay_kim)) ALLOCATE(zlay_kim(ngrid,nlaykim_tot))
     71    IF (.NOT.allocated(ykim_up)) ALLOCATE(ykim_up(44,ngrid,nlaykim_up))
     72 
     73  END SUBROUTINE ini_comchem_h
     74
     75
    3576END MODULE comchem_h

  • trunk/LMDZ.TITAN/libf/phytitan/phyetat0_mod.F90

    r1789 r1894  
    264264endif ! of if (nq.ge.1)
    265265
    266 
    267266if (startphy_file) then
    268267  ! Call to soil_settings, in order to read soil temperatures,
    … …  
    270269  call soil_settings(nid_start,ngrid,nsoil,tsurf,tsoil,indextime)
    271270endif ! of if (startphy_file)
     271
     272! Upper chemistry
     273if (startphy_file) then
     274  ! Call to soil_settings, in order to read upper chemistry
     275  ! pressure grid as well as composition fields
     276  call chem_settings(nid_start,ngrid,indextime)
     277endif ! of if (startphy_file)
     278
    272279!
    273280! close file:

  • trunk/LMDZ.TITAN/libf/phytitan/phyredem.F90

    r1889 r1894  
    143143  use iostart, only : open_restartphy, close_restartphy, &
    144144                      put_var, put_field
     145  use comchem_h, only: cnames, ykim_up
    145146  use tracer_h, only: noms
     147  use callkeys_mod, only: callchim
    146148
    147149  implicit none
    … …  
    185187  call put_field("tankCH4","Depth of methane tank",tankCH4)
    186188 
    187 ! tracers
     189  ! Tracers
    188190  if (nq>0) then
    189191    do iq=1,nq
    … …  
    191193    enddo
    192194  endif ! of if (nq>0)
    193 
     195 
     196  ! Upper chemistry
     197  if (callchim) then
     198    do iq=1,44
     199      call put_field(trim(cnames(iq))//"_up",trim(cnames(iq))//" in upper atmosphere",ykim_up(iq,:,:))
     200    enddo
     201  endif ! of if callchim
     202 
    194203! close file
    195204      CALL close_restartphy

  • trunk/LMDZ.TITAN/libf/phytitan/tracer_h.F90

    r1843 r1894  
    6868    USE callkeys_mod
    6969    USE comcstfi_mod, only: mugaz
     70    USE comchem_h, only: cnames, cmmol
    7071    IMPLICIT NONE
    7172
    … …  
    7677    LOGICAL                                      :: verb,found
    7778    CHARACTER(len=20)                            :: str
    78     !! Hard-coded chemical species for Titan chemistry
    79     CHARACTER(len=10), DIMENSION(44), PARAMETER  :: cnames = &
    80       (/"H         ", "H2        ", "CH        ", "CH2s      ", "CH2       ", "CH3       ", &
    81         "CH4       ", "C2        ", "C2H       ", "C2H2      ", "C2H3      ", "C2H4      ", &
    82         "C2H5      ", "C2H6      ", "C3H3      ", "C3H5      ", "C3H6      ", "C3H7      ", &
    83         "C4H       ", "C4H3      ", "C4H4      ", "C4H2s     ", "CH2CCH2   ", "CH3CCH    ", &
    84         "C3H8      ", "C4H2      ", "C4H6      ", "C4H10     ", "AC6H6     ", "C3H2      ", &
    85         "C4H5      ", "AC6H5     ", "N2        ", "N4S       ", "CN        ", "HCN       ", &
    86         "H2CN      ", "CHCN      ", "CH2CN     ", "CH3CN     ", "C3N       ", "HC3N      ", &
    87         "NCCN      ", "C4N2      "/)
    88     !! Hard-coded chemical species molar mass (g.mol-1), shares the same indexing than cnames.
    89     REAL, DIMENSION(44), PARAMETER               :: cmmol = (/ &
    90         1.01   , 2.0158, 13.02, 14.03, 14.03, 15.03, 16.04  , 24.02, 25.03, 26.04  , 27.05  , &
    91         28.05  , 29.06 , 30.07, 39.06, 41.07, 42.08, 43.09  , 49.05, 51.07, 52.08  , 50.06  , &
    92         40.07  , 40.07 , 44.11, 50.06, 54.09, 58.13, 78.1136, 38.05, 53.07, 77.1136, 28.0134, &
    93         14.01  , 26.02 , 27.04, 28.05, 39.05, 40.04, 41.05  , 50.04, 51.05, 52.04  , 76.1   /)
    9479
    9580    INTEGER :: i,j,n
Note: See TracChangeset for help on using the changeset viewer.