Ignore:
Timestamp:
Jun 4, 2015, 10:21:20 AM (10 years ago)
Author:
emillour
Message:

Updates in common dynamics (seq and ) to keep up with updates
in LMDZ5 (up to LMDZ5 trunk, rev 2250):

  • compilation:
  • added test in grid/dimension/makdim to check that # of longitudes is a multiple of 8
  • dyn3d_common:

Bug correction concerning zoom (cf LMDZ5 rev 2218)

  • coefpoly.F becomes coefpoly_m.F90 (in misc)
  • fxhyp.F => fxhyp_m.F90 , fyhyp.F => fyhyp_m.F90
  • new routines for zoom: invert_zoom_x_m.F90 and principal_cshift_m.F90
  • inigeom.F adapted to new zoom definition routines
  • fluxstokenc.F : got rid of calls to initial0()
  • dyn3d:
  • advtrac.F90 : got rid of calls to initial0()
  • conf_gcm.F90 : cosmetic changes and change in default dzoomx,dzoomy values
  • guide_mod.F90 : followed updates from Earth Model
  • gcm.F is now gcm.F90
  • dyn3dpar:
  • advtrac_p.F90, covcont_p.F90, mod_hallo.F90 : cosmetic changes
  • conf_gcm.F90 : cosmetic and changed in default dzoomx,dzoomy values
  • parallel_lmdz.F90 : updates to keep up with Earth model
  • misc:
  • arth.F90 becomes arth_m.F90
  • wxios.F90 updated wrt Earth model changes
  • nrtype.F90 and coefpoly_m.F90 added
  • ran1.F, sort.F, minmax.F, minmax2.F, juldate.F moved over from dyn3d_common

EM

Location:
trunk/LMDZ.COMMON/libf/misc
Files:
1 added
1 edited
7 moved

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.COMMON/libf/misc/coefpoly_m.F90

    r1440 r1441  
    1 !
    2 ! $Header$
    3 !
    4       SUBROUTINE coefpoly ( Xf1, Xf2, Xprim1, Xprim2, xtild1,xtild2 ,
    5      ,                                          a0,a1,a2,a3         )
    6       IMPLICIT NONE
    7 c
    8 c   ...  Auteur :   P. Le Van  ...
    9 c
    10 c
    11 c    Calcul des coefficients a0, a1, a2, a3 du polynome de degre 3 qui
    12 c      satisfait aux 4 equations  suivantes :
     1module coefpoly_m
    132
    14 c    a0 + a1*xtild1 + a2*xtild1*xtild1 + a3*xtild1*xtild1*xtild1 = Xf1
    15 c    a0 + a1*xtild2 + a2*xtild2*xtild2 + a3*xtild2*xtild2*xtild2 = Xf2
    16 c               a1  +     2.*a2*xtild1 +     3.*a3*xtild1*xtild1 = Xprim1
    17 c               a1  +     2.*a2*xtild2 +     3.*a3*xtild2*xtild2 = Xprim2
     3  IMPLICIT NONE
    184
    19 c  On en revient a resoudre un systeme de 4 equat.a 4 inconnues a0,a1,a2,a3
     5contains
    206
    21       REAL(KIND=8) Xf1, Xf2,Xprim1,Xprim2, xtild1,xtild2, xi
    22       REAL(KIND=8) Xfout, Xprim
    23       REAL(KIND=8) a1,a2,a3,a0, xtil1car, xtil2car,derr,x1x2car
     7  SUBROUTINE coefpoly(xf1, xf2, xprim1, xprim2, xtild1, xtild2, a0, a1, a2, a3)
    248
    25       xtil1car = xtild1 * xtild1
    26       xtil2car = xtild2 * xtild2
     9    ! From LMDZ4/libf/dyn3d/coefpoly.F, version 1.1.1.1 2004/05/19 12:53:05
    2710
    28       derr= 2. *(Xf2-Xf1)/( xtild1-xtild2)
     11    ! Author: P. Le Van
    2912
    30       x1x2car = ( xtild1-xtild2)*(xtild1-xtild2)
     13    ! Calcul des coefficients a0, a1, a2, a3 du polynôme de degré 3 qui
     14    ! satisfait aux 4 équations suivantes :
    3115
    32       a3 = (derr + Xprim1+Xprim2 )/x1x2car
    33       a2     = ( Xprim1 - Xprim2 + 3.* a3 * ( xtil2car-xtil1car ) )    /
    34      /           (  2.* ( xtild1 - xtild2 )  )
     16    ! a0 + a1 * xtild1 + a2 * xtild1**2 + a3 * xtild1**3 = Xf1
     17    ! a0 + a1 * xtild2 + a2 * xtild2**2 + a3 * xtild2**3 = Xf2
     18    ! a1 + 2. * a2 * xtild1 + 3. * a3 * xtild1**2 = Xprim1
     19    ! a1 + 2. * a2 * xtild2 + 3. * a3 * xtild2**2 = Xprim2
    3520
    36       a1     = Xprim1 -3.* a3 * xtil1car     -2.* a2 * xtild1
    37       a0     =  Xf1 - a3 * xtild1* xtil1car -a2 * xtil1car - a1 *xtild1
     21    ! (passe par les points (Xf(it), xtild(it)) et (Xf(it + 1),
     22    ! xtild(it + 1))
    3823
    39       RETURN
    40       END
     24    ! On en revient à resoudre un système de 4 équations à 4 inconnues
     25    ! a0, a1, a2, a3.
     26
     27    use nrtype, only: k8
     28
     29    REAL(K8), intent(in):: xf1, xf2, xprim1, xprim2, xtild1, xtild2
     30    REAL(K8), intent(out):: a0, a1, a2, a3
     31
     32    ! Local:
     33    REAL(K8) xtil1car, xtil2car, derr, x1x2car
     34
     35    !------------------------------------------------------------
     36
     37    xtil1car = xtild1 * xtild1
     38    xtil2car = xtild2 * xtild2
     39
     40    derr = 2. * (xf2-xf1)/(xtild1-xtild2)
     41
     42    x1x2car = (xtild1-xtild2) * (xtild1-xtild2)
     43
     44    a3 = (derr+xprim1+xprim2)/x1x2car
     45    a2 = (xprim1-xprim2+3. * a3 * (xtil2car-xtil1car))/(2. * (xtild1-xtild2))
     46
     47    a1 = xprim1 - 3. * a3 * xtil1car - 2. * a2 * xtild1
     48    a0 = xf1 - a3 * xtild1 * xtil1car - a2 * xtil1car - a1 * xtild1
     49
     50  END SUBROUTINE coefpoly
     51
     52end module coefpoly_m

  • trunk/LMDZ.COMMON/libf/misc/wxios.F90

    r1302 r1441  
    9393    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    9494    ! Routine d'initialisation      !!!!!!!!!!!!!
    95     !     A lancer juste après mpi_init !!!!!!!!!!!!!
     95    !     A lancer juste après mpi_init !!!!!!!!!!!!!
    9696    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    9797
    … …  
    145145        !Initialisation du contexte:
    146146        CALL xios_context_initialize(g_ctx_name, g_comm)
    147         CALL xios_get_handle(g_ctx_name, xios_ctx)    !Récupération
     147        CALL xios_get_handle(g_ctx_name, xios_ctx)    !Récupération
    148148        CALL xios_set_current_context(xios_ctx)            !Activation
    149149        g_ctx = xios_ctx
    … …  
    153153          WRITE(lunout,*) "     now call xios_solve_inheritance()"
    154154        ENDIF
    155         !Une première analyse des héritages:
     155        !Une première analyse des héritages:
    156156        CALL xios_solve_inheritance()
    157157    END SUBROUTINE wxios_context_init
    158158
    159159    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    160     ! Routine de paramétrisation !!!!!!!!!!!!!!!!!!
    161     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    162 
    163     SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure)
    164         IMPLICIT NONE
    165         INCLUDE 'iniprint.h'
    166 
    167      !Paramètres:
     160    ! Routine de paramétrisation !!!!!!!!!!!!!!!!!!
     161    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     162
     163    SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure, ini_an, ini_mois, ini_jour, ini_heure)
     164        IMPLICIT NONE
     165        INCLUDE 'iniprint.h'
     166
     167     !Paramètres:
    168168     CHARACTER(len=*), INTENT(IN) :: calendrier
    169      INTEGER, INTENT(IN) :: annee, mois, jour
    170      REAL, INTENT(IN) :: pasdetemps, heure
     169     INTEGER, INTENT(IN) :: annee, mois, jour, ini_an, ini_mois, ini_jour
     170     REAL, INTENT(IN) :: pasdetemps, heure, ini_heure
    171171     
    172172     !Variables:
    … …  
    181181        mdtime = xios_time(0, 0, 0, 0, 0, pasdetemps)
    182182
    183         !Réglage du calendrier:
     183        !Réglage du calendrier:
    184184        SELECT CASE (calendrier)
    185185            CASE('earth_360d')
    … …  
    197197        END SELECT
    198198       
    199         !Formatage de la date de départ:
    200         WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") annee, mois, jour
    201        
    202         IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Initial time: ", date
    203        
    204         CALL xios_set_context_attr_hdl(g_ctx, start_date= date)
     199        !Formatage de la date d'origine:
     200        WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") annee, mois, jour, int(heure)
     201       
     202        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Time origin: ", date
     203       
     204        CALL xios_set_context_attr_hdl(g_ctx, time_origin = date)
     205
     206        !Formatage de la date de debut:
     207
     208        WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") ini_an, ini_mois, ini_jour, int(ini_heure)
     209       
     210        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Start date: ", date
     211       
     212        CALL xios_set_context_attr_hdl(g_ctx, start_date = date)
    205213       
    206214        !Et enfin,le pas de temps:
    … …  
    253261        LOGICAL :: boool
    254262       
    255         !Masque pour les problèmes de recouvrement MPI:
     263        !Masque pour les problèmes de recouvrement MPI:
    256264        LOGICAL :: mask(ni,nj)
    257265       
    258         !On récupère le handle:
     266        !On récupère le handle:
    259267        CALL xios_get_domain_handle(dom_id, dom)
    260268       
    … …  
    285293
    286294         CALL xios_is_defined_domain_attr_hdl(dom,ni_glo=boool)
    287         !Vérification:
     295        !Vérification:
    288296        IF (xios_is_valid_domain(dom_id)) THEN
    289297            IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool
    … …  
    294302   
    295303    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    296     ! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
     304    ! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
    297305    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    298306    SUBROUTINE wxios_add_vaxis(axis_id, axis_size, axis_value)
    … …  
    315323!        axis_id=trim(axisgroup_id)
    316324       
    317         !On récupère le groupe d'axes qui va bien:
     325        !On récupère le groupe d'axes qui va bien:
    318326        !CALL xios_get_axisgroup_handle(axisgroup_id, axgroup)
    319327       
    320         !On ajoute l'axe correspondant à ce fichier:
     328        !On ajoute l'axe correspondant à ce fichier:
    321329        !CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
    322330       
    … …  
    327335        CALL xios_set_axis_attr(trim(axis_id),size=axis_size,value=axis_value)
    328336       
    329         !Vérification:
     337        !Vérification:
    330338        IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN
    331339            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
    … …  
    338346   
    339347    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    340     ! Pour déclarer un fichier  !!!!!!!!!!!!!!!!!!!
     348    ! Pour déclarer un fichier  !!!!!!!!!!!!!!!!!!!
    341349    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    342350    SUBROUTINE wxios_add_file(fname, ffreq, flvl)
    … …  
    352360        CHARACTER(len=100) :: nffreq
    353361       
    354         !On regarde si le fichier n'est pas défini par XML:
     362        !On regarde si le fichier n'est pas défini par XML:
    355363        IF (.NOT.xios_is_valid_file(fname)) THEN
    356             !On créé le noeud:
     364            !On créé le noeud:
    357365            CALL xios_get_filegroup_handle("defile", x_fg)
    358366            CALL xios_add_file(x_fg, x_file, fname)
    359367       
    360             !On reformate la fréquence:
     368            !On reformate la fréquence:
    361369            CALL reformadate(ffreq, nffreq)
    362370       
    … …  
    376384        ELSE
    377385            IF (prt_level >= 10) THEN
    378               WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
     386              WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
    379387            ENDIF
    380388            ! Ehouarn: add an enable=.true. on top of xml definitions... why???
    … …  
    384392   
    385393    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    386     ! Pour créer un champ      !!!!!!!!!!!!!!!!!!!!
     394    ! Pour créer un champ      !!!!!!!!!!!!!!!!!!!!
    387395    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    388396    SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
    … …  
    401409        REAL(KIND=8) :: def
    402410       
    403         !La valeur par défaut des champs non définis:
     411        !La valeur par défaut des champs non définis:
    404412        def = nf90_fill_real
    405413       
    … …  
    414422        !IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
    415423       
    416         !On rentre ses paramètres:
     424        !On rentre ses paramètres:
    417425        CALL xios_set_field_attr_hdl(field, standard_name=fieldlongname, unit=newunit, default_value=def)
    418426        IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: Field ",trim(fieldname), "cree:"
    … …  
    422430   
    423431    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    424     ! Pour déclarer un champ      !!!!!!!!!!!!!!!!!
    425     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    426     SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op)
     432    ! Pour déclarer un champ      !!!!!!!!!!!!!!!!!
     433    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     434    SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op, nam_axvert)
    427435        IMPLICIT NONE
    428436        INCLUDE 'iniprint.h'
    … …  
    437445       
    438446        CHARACTER(len=20) :: axis_id ! Ehouarn: dangerous...
     447        CHARACTER(len=20), INTENT(IN), OPTIONAL :: nam_axvert
    439448        CHARACTER(len=100) :: operation
    440449        TYPE(xios_file) :: f
    … …  
    451460          axis_id="plev"
    452461        ENDIF
    453        
    454         !on prépare le nom de l'opération:
     462 
     463        IF (PRESENT(nam_axvert)) THEN
     464           axis_id=nam_axvert
     465           print*,'nam_axvert=',axis_id
     466        ENDIF
     467       
     468        !on prépare le nom de l'opération:
    455469        operation = reformaop(op)
    456470       
    … …  
    463477        ENDIF
    464478       
    465         !On regarde si le champ à déjà été créé ou non:
     479        !On regarde si le champ à déjà été créé ou non:
    466480        IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
    467             !Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
     481            !Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
    468482            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
    469483            g_flag_xml = .TRUE.
    … …  
    471485
    472486        ELSE IF (.NOT. g_field_name == fieldname) THEN
    473             !Si premier pssage et champ indéfini, alors on le créé
     487            !Si premier pssage et champ indéfini, alors on le créé
    474488
    475489            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
    476490           
    477             !On le créé:
     491            !On le créé:
    478492            CALL wxios_add_field(fieldname,  fieldgroup, fieldlongname, fieldunit)
    479493            IF (xios_is_valid_field(fieldname)) THEN
    … …  
    487501
    488502        IF (.NOT. g_flag_xml) THEN
    489             !Champ existe déjà, mais pas XML, alors on l'ajoute
     503            !Champ existe déjà, mais pas XML, alors on l'ajoute
    490504            !On ajoute le champ:
    491505            CALL xios_get_file_handle(fname, f)
    … …  
    497511
    498512           
    499             !On rentre ses paramètres:
     513            !On rentre ses paramètres:
    500514            CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.TRUE.)
    501515           
    … …  
    550564    SUBROUTINE wxios_closedef()
    551565        CALL xios_close_context_definition()
    552         CALL xios_update_calendar(0)
     566!        CALL xios_update_calendar(0)
    553567    END SUBROUTINE wxios_closedef
    554568   
    … …  
    559573END MODULE wxios
    560574#endif
    561 
Note: See TracChangeset for help on using the changeset viewer.