Changeset 1892


Ignore:
Timestamp:
Jan 10, 2018, 6:21:35 PM (7 years ago)
Author:
jvatant
Message:

Making chemistry handling more flexible - step 3
+ Added the horizontal interpolation for chemistry fields
+ Next step : deal with vertical interp !
--JVO

Location:
trunk/LMDZ.TITAN/libf
Files:
4 edited

Legend:

Unmodified
Added
Removed

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

    r1891 r1892  
    1717 
    1818  ! Nouvelle grille physique, ancienne grille verticale
    19   REAL,ALLOCATABLE :: oldykim_up(:,:) 
     19  REAL,ALLOCATABLE :: ykim_up_oldv(:,:,:) 
    2020
    2121  ! Nouvelle grille scalaire, ancienne grille verticale 
    22   REAL,ALLOCATABLE :: ykim_upS(:,:,:) 
     22  REAL,ALLOCATABLE :: ykim_upS(:,:,:,:) 
    2323
    2424  ! Ancienne grille scalaire, ancienne grille verticale 
    25   REAL,ALLOCATABLE :: ykim_upoldS(:,:,:) 
     25  REAL,ALLOCATABLE :: ykim_upoldS(:,:,:,:)
     26 
     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(*,*)
    26780
     781  END SUBROUTINE read_startarch_kim
    27782 
    28783END MODULE comchem_newstart_h

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

    r1891 r1892  
    1010!      USE control_mod
    1111! to use  'getin'
     12      USE callkeys_mod, only: callchim
    1213      USE comvert_mod, ONLY: ap,bp,aps,bps,preff
    1314      USE comconst_mod, ONLY: kappa,g,pi
    … …  
    256257      ierr= NF_INQ_DIMID(nid,"upper_chemistry_layers",dimid)
    257258      ierr= NF_INQ_DIMLEN(nid,dimid,nlaykimold)
    258 
    259       ! NB : The vertical regriding, if needed cannot be done here since the new
    260       ! pressure grid is only computed at the end of newstart
    261       ! Here we will just do the horizontal interpolation on scalar grid.
    262259
    263260! 1.3 Report dimensions
    … …  
    307304     
    308305      allocate(preskimold(nlaykimold))
    309       allocate(ykim_upS(44,iip1,jjp1))
    310       allocate(ykim_upoldS(44,imold+1,jmold+1))
     306      allocate(ykim_upS(44,iip1,jjp1,nlaykimold))
     307      allocate(ykim_upoldS(44,imold+1,jmold+1,nlaykimold))
     308      allocate(ykim_up_oldv(44,ngrid,nlaykimold))
    311309
    312310      allocate(var (imold+1,jmold+1,llm))
    … …  
    830828!      endif
    831829
    832 c-----------------------------------------------------------------------
    833 c 5.3   Lecture des champs 3D (t,u,v, q2atm,q)
     830
     831c-----------------------------------------------------------------------
     832c 5.3 Read 3D upper chemistry fields, if needed
     833c----------------------------------------------------------------------- 
     834       
     835      start=(/1,1,1,memo/)
     836      count=(/imold+1,jmold+1,nlaykimold,1/)
     837   
     838c NB : The sanity check on callchim is on H_up but could be on any chem. field
     839c as we assume we can't do incomplete chemistry - JVO 18
     840   
     841      PRINT*, "lect_start_archive: loading upper chemistry fields..."
     842     
     843      ierr=NF_INQ_VARID(nid,"H_up",nvarid)
     844     
     845      IF (ierr .NE. NF_NOERR) THEN
     846     
     847         PRINT*, "lect_start_archive: Le champ <H_up> est absent..."       
     848         IF (callchim) THEN
     849           PRINT*, "... mais callchim=.TRUE. dans callphys.def !"
     850           PRINT*, "Verifiez start_archive.nc ou desactivez callchim !"
     851           CALL abort
     852         ELSE
     853           PRINT*, '... je suppose que les autres champs aussi et je
     854     &passerai donc mon chemin pour tout ce qui concerne la chimie !'
     855           WRITE (*,*)
     856         ENDIF
     857         
     858      ELSE
     859     
     860        IF (.not.callchim) THEN
     861          PRINT*, "lect_start_archive: Le champ <H_up> est present..."
     862          PRINT*, "... mais callchim=.FALSE. dans callphys.def !"
     863          PRINT*, "Veuillez activer callchim pour gerer ce champ !"
     864          CALL abort
     865        ELSE
     866#ifdef NC_DOUBLE
     867          ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,
     868     &                             ykim_upoldS(1,:,:,:))
     869#else
     870          ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,
     871     &                            ykim_upoldS(1,:,:,:))
     872#endif
     873          IF (ierr .NE. NF_NOERR) THEN
     874             PRINT*, "lect_start_archive: Lecture echouee pour <H_up>"
     875             CALL abort
     876          ENDIF         
     877          ! Then read all the others by their name if needed
     878          CALL read_startarch_kim(nid,start,count)             
     879         ENDIF
     880         
     881      ENDIF  ! if ierr.ne.nf_no_err
     882
     883c-----------------------------------------------------------------------
     884c 5.4   Lecture des champs 3D (t,u,v, q2atm,q)
    834885c-----------------------------------------------------------------------
    835886
    … …  
    11611212      ! Reshape tsoilS to scalar grid as tsoil
    11621213       call gr_dyn_fi (nsoilmx,iim+1,jjm+1,ngrid,tsoilS,tsoil)
    1163 
    1164 c-----------------------------------------------------------------------
    1165 c 6.3 Variable 3d :
     1214       
     1215c-----------------------------------------------------------------------
     1216c 6.3 Upper chemistry 3d fields:
     1217c
     1218c NB : The vertical regriding, if needed cannot be done here since the
     1219c new pressure grid is only computed at the end of newstart.
     1220c Here we will just do the horizontal interpolation on scalar grid.
     1221c
     1222c-----------------------------------------------------------------------
     1223
     1224      ! Do the horizontal interpolation
     1225      DO i=1,44
     1226        call interp_horiz(ykim_upoldS(i,:,:,:),ykim_upS(i,:,:,:),
     1227     &                  imold,jmold,iim,jjm,nlaykimold,
     1228     &                   rlonuold,rlatvold,rlonu,rlatv)
     1229
     1230        ! Reshape ykim_upS to scalar grid as ykim_up_oldv
     1231        call gr_dyn_fi(nlaykimold,iim+1,jjm+1,ngrid,
     1232     &                 ykim_upS(i,:,:,:),ykim_up_oldv(i,:,:))
     1233      ENDDO
     1234
     1235
     1236c-----------------------------------------------------------------------
     1237c 6.4 Variable 3d :
    11661238c-----------------------------------------------------------------------
    11671239     
    … …  
    13281400      deallocate(qsurfold)
    13291401      deallocate(var,varp1)
     1402     
     1403      deallocate(ykim_upS)
     1404      deallocate(ykim_upoldS)
    13301405
    13311406!      write(*,*)'lect_start_archive: END'

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

    r1891 r1892  
    10901090
    10911091          WRITE(*,*) " Warning, nlaykimold=", nlaykimold
    1092           WRITE(*,*) ' which implies that a regriding on upper chemistry
    1093      & fields will be performed.'
     1092          WRITE(*,*) ' which implies that a vertical regriding on upper 
     1093     &chemistry fields will be performed.'
    10941094          WRITE(*,*)
    10951095         
    1096 !          CALL regrid_kim(ngridmx)
     1096!          CALL vert_regrid_kim(ngridmx)
    10971097         
    10981098        ENDIF

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

    r1891 r1892  
    11MODULE comchem_h
    22
    3 ! Stores data relative to upper chemistry in the GCM
    4 ! For newstart there is a specific comchem_newstart_h module.
    5 
     3! -----------------------------------------------------------------------
     4! Purpose : Stores data relative to upper chemistry in the GCM
     5! -------   For newstart there is a specific comchem_newstart_h module.
     6!
    67! Author : Jan Vatant d'Ollone (2017)
     8! ------
     9!
     10! NB : A given order is assumed for the 44 chemistry tracers :
     11! --   H, H2, CH, CH2s, CH2, CH3, CH4, C2, C2H, C2H2, C2H3, C2H4, C2H5,
     12!      C2H6, C3H3, C3H5, C3H6, C3H7, C4H, C4H3, C4H4, C4H2s, CH2CCH2,
     13!      CH3CCH, C3H8, C4H2, C4H6, C4H10, AC6H6, C3H2, C4H5, AC6H5, N2,
     14!      N4S, CN, HCN, H2CN, CHCN, CH2CN, CH3CN, C3N, HC3N, NCCN, C4N2
     15       
     16! --------------------------------------------------------------------------
    717
    818IMPLICIT NONE 
Note: See TracChangeset for help on using the changeset viewer.