Changeset 2117 for LMDZ5/trunk/libf


Ignore:
Timestamp:
Sep 11, 2014, 8:47:39 PM (10 years ago)
Author:
fhourdin
Message:

Modification de la lecture du cas 1D AMMA en vue d'une generatlisation
de la specification des forcages decidee dans le cadre de DEPHY.
Passage a une allocation dynamique des fichiers pour permettre
de lire la dimension des variables dans le fichier de forcage.
Marche avec AMMA et le noveau cas IHOP.

Change of 1D cases forcing. Introduction of allocated variable.
For AMMA and IHOP.

Location:
LMDZ5/trunk/libf/phylmd
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/1DUTILS.h

    r2096 r2117  
    29092909        return
    29102910        end
    2911 !=====================================================================
    2912       subroutine read_amma(fich_amma,nlevel,ntime                          &
    2913      &     ,zz,pp,temp,qv,u,v,dw                                           &
    2914      &     ,dt,dq,sens,flat)
    2915 
    2916 !program reading forcings of the AMMA case study
    2917 
    2918 
    2919       implicit none
    2920 
    2921 #include "netcdf.inc"
    2922 
    2923       integer ntime,nlevel
    2924       character*80 :: fich_amma
    2925       real*8 zz(nlevel)
    2926 
    2927       real*8 temp(nlevel),pp(nlevel)
    2928       real*8 qv(nlevel),u(nlevel)
    2929       real*8 v(nlevel)
    2930       real*8 dw(nlevel,ntime)
    2931       real*8 dt(nlevel,ntime)
    2932       real*8 dq(nlevel,ntime)
    2933       real*8 flat(ntime),sens(ntime)
    2934 
    2935       integer nid, ierr
    2936       integer nbvar3d
    2937       parameter(nbvar3d=30)
    2938       integer var3didin(nbvar3d)
    2939 
    2940       ierr = NF_OPEN(fich_amma,NF_NOWRITE,nid)
    2941       if (ierr.NE.NF_NOERR) then
    2942          write(*,*) 'ERROR: Pb opening forcings nc file '
    2943          write(*,*) NF_STRERROR(ierr)
    2944          stop ""
    2945       endif
    2946 
    2947 
    2948        ierr=NF_INQ_VARID(nid,"zz",var3didin(1))
    2949          if(ierr/=NF_NOERR) then
    2950            write(*,*) NF_STRERROR(ierr)
    2951            stop 'lev'
    2952          endif
    2953 
    2954 
    2955       ierr=NF_INQ_VARID(nid,"temp",var3didin(2))
    2956          if(ierr/=NF_NOERR) then
    2957            write(*,*) NF_STRERROR(ierr)
    2958            stop 'temp'
    2959          endif
    2960 
    2961       ierr=NF_INQ_VARID(nid,"qv",var3didin(3))
    2962          if(ierr/=NF_NOERR) then
    2963            write(*,*) NF_STRERROR(ierr)
    2964            stop 'qv'
    2965          endif
    2966 
    2967       ierr=NF_INQ_VARID(nid,"u",var3didin(4))
    2968          if(ierr/=NF_NOERR) then
    2969            write(*,*) NF_STRERROR(ierr)
    2970            stop 'u'
    2971          endif
    2972 
    2973       ierr=NF_INQ_VARID(nid,"v",var3didin(5))
    2974          if(ierr/=NF_NOERR) then
    2975            write(*,*) NF_STRERROR(ierr)
    2976            stop 'v'
    2977          endif
    2978 
    2979       ierr=NF_INQ_VARID(nid,"dw",var3didin(6))
    2980          if(ierr/=NF_NOERR) then
    2981            write(*,*) NF_STRERROR(ierr)
    2982            stop 'dw'
    2983          endif
    2984 
    2985       ierr=NF_INQ_VARID(nid,"dt",var3didin(7))
    2986          if(ierr/=NF_NOERR) then
    2987            write(*,*) NF_STRERROR(ierr)
    2988            stop 'dt'
    2989          endif
    2990 
    2991       ierr=NF_INQ_VARID(nid,"dq",var3didin(8))
    2992          if(ierr/=NF_NOERR) then
    2993            write(*,*) NF_STRERROR(ierr)
    2994            stop 'dq'
    2995          endif
    2996      
    2997       ierr=NF_INQ_VARID(nid,"sens",var3didin(9))
    2998          if(ierr/=NF_NOERR) then
    2999            write(*,*) NF_STRERROR(ierr)
    3000            stop 'sens'
    3001          endif
    3002 
    3003       ierr=NF_INQ_VARID(nid,"flat",var3didin(10))
    3004          if(ierr/=NF_NOERR) then
    3005            write(*,*) NF_STRERROR(ierr)
    3006            stop 'flat'
    3007          endif
    3008 
    3009       ierr=NF_INQ_VARID(nid,"pp",var3didin(11))
    3010          if(ierr/=NF_NOERR) then
    3011            write(*,*) NF_STRERROR(ierr)
    3012            stop 'pp'
    3013       endif
    3014 
    3015 !dimensions lecture
    3016 !      call catchaxis(nid,ntime,nlevel,time,z,ierr)
    3017  
    3018 #ifdef NC_DOUBLE
    3019          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz)
    3020 #else
    3021          ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz)
    3022 #endif
    3023          if(ierr/=NF_NOERR) then
    3024             write(*,*) NF_STRERROR(ierr)
    3025             stop "getvarup"
    3026          endif
    3027 !          write(*,*)'lecture z ok',zz
    3028 
    3029 #ifdef NC_DOUBLE
    3030          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),temp)
    3031 #else
    3032          ierr = NF_GET_VAR_REAL(nid,var3didin(2),temp)
    3033 #endif
    3034          if(ierr/=NF_NOERR) then
    3035             write(*,*) NF_STRERROR(ierr)
    3036             stop "getvarup"
    3037          endif
    3038 !          write(*,*)'lecture th ok',temp
    3039 
    3040 #ifdef NC_DOUBLE
    3041          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),qv)
    3042 #else
    3043          ierr = NF_GET_VAR_REAL(nid,var3didin(3),qv)
    3044 #endif
    3045          if(ierr/=NF_NOERR) then
    3046             write(*,*) NF_STRERROR(ierr)
    3047             stop "getvarup"
    3048          endif
    3049 !          write(*,*)'lecture qv ok',qv
    3050  
    3051 #ifdef NC_DOUBLE
    3052          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),u)
    3053 #else
    3054          ierr = NF_GET_VAR_REAL(nid,var3didin(4),u)
    3055 #endif
    3056          if(ierr/=NF_NOERR) then
    3057             write(*,*) NF_STRERROR(ierr)
    3058             stop "getvarup"
    3059          endif
    3060 !          write(*,*)'lecture u ok',u
    3061 
    3062 #ifdef NC_DOUBLE
    3063          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),v)
    3064 #else
    3065          ierr = NF_GET_VAR_REAL(nid,var3didin(5),v)
    3066 #endif
    3067          if(ierr/=NF_NOERR) then
    3068             write(*,*) NF_STRERROR(ierr)
    3069             stop "getvarup"
    3070          endif
    3071 !          write(*,*)'lecture v ok',v
    3072 
    3073 #ifdef NC_DOUBLE
    3074          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),dw)
    3075 #else
    3076          ierr = NF_GET_VAR_REAL(nid,var3didin(6),dw)
    3077 #endif
    3078          if(ierr/=NF_NOERR) then
    3079             write(*,*) NF_STRERROR(ierr)
    3080             stop "getvarup"
    3081          endif
    3082 !          write(*,*)'lecture w ok',dw
    3083 
    3084 #ifdef NC_DOUBLE
    3085          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),dt)
    3086 #else
    3087          ierr = NF_GET_VAR_REAL(nid,var3didin(7),dt)
    3088 #endif
    3089          if(ierr/=NF_NOERR) then
    3090             write(*,*) NF_STRERROR(ierr)
    3091             stop "getvarup"
    3092          endif
    3093 !          write(*,*)'lecture dt ok',dt
    3094 
    3095 #ifdef NC_DOUBLE
    3096          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),dq)
    3097 #else
    3098          ierr = NF_GET_VAR_REAL(nid,var3didin(8),dq)
    3099 #endif
    3100          if(ierr/=NF_NOERR) then
    3101             write(*,*) NF_STRERROR(ierr)
    3102             stop "getvarup"
    3103          endif
    3104 !          write(*,*)'lecture dq ok',dq
    3105 
    3106 #ifdef NC_DOUBLE
    3107          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),sens)
    3108 #else
    3109          ierr = NF_GET_VAR_REAL(nid,var3didin(9),sens)
    3110 #endif
    3111          if(ierr/=NF_NOERR) then
    3112             write(*,*) NF_STRERROR(ierr)
    3113             stop "getvarup"
    3114          endif
    3115 !          write(*,*)'lecture sens ok',sens
    3116 
    3117 #ifdef NC_DOUBLE
    3118          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),flat)
    3119 #else
    3120          ierr = NF_GET_VAR_REAL(nid,var3didin(10),flat)
    3121 #endif
    3122          if(ierr/=NF_NOERR) then
    3123             write(*,*) NF_STRERROR(ierr)
    3124             stop "getvarup"
    3125          endif
    3126 !          write(*,*)'lecture flat ok',flat
    3127 
    3128 #ifdef NC_DOUBLE
    3129          ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),pp)
    3130 #else
    3131          ierr = NF_GET_VAR_REAL(nid,var3didin(11),pp)
    3132 #endif
    3133          if(ierr/=NF_NOERR) then
    3134             write(*,*) NF_STRERROR(ierr)
    3135             stop "getvarup"
    3136          endif
    3137 !          write(*,*)'lecture pp ok',pp
    3138 
    3139          return
    3140          end subroutine read_amma
    3141 !======================================================================
    3142         SUBROUTINE interp_amma_time(day,day1,annee_ref                     &
    3143      &         ,year_ini_amma,day_ini_amma,nt_amma,dt_amma,nlev_amma       &
    3144      &         ,vitw_amma,ht_amma,hq_amma,lat_amma,sens_amma               &
    3145      &         ,vitw_prof,ht_prof,hq_prof,lat_prof,sens_prof)
    3146         implicit none
    3147 
    3148 !---------------------------------------------------------------------------------------
    3149 ! Time interpolation of a 2D field to the timestep corresponding to day
    3150 !
    3151 ! day: current julian day (e.g. 717538.2)
    3152 ! day1: first day of the simulation
    3153 ! nt_amma: total nb of data in the forcing (e.g. 48 for AMMA)
    3154 ! dt_amma: total time interval (in sec) between 2 forcing data (e.g. 30min for AMMA)
    3155 !---------------------------------------------------------------------------------------
    3156 
    3157 #include "compar1d.h"
    3158 
    3159 ! inputs:
    3160         integer annee_ref
    3161         integer nt_amma,nlev_amma
    3162         integer year_ini_amma
    3163         real day, day1,day_ini_amma,dt_amma
    3164         real vitw_amma(nlev_amma,nt_amma)
    3165         real ht_amma(nlev_amma,nt_amma)
    3166         real hq_amma(nlev_amma,nt_amma)
    3167         real lat_amma(nt_amma)
    3168         real sens_amma(nt_amma)
    3169 ! outputs:
    3170         real vitw_prof(nlev_amma)
    3171         real ht_prof(nlev_amma)
    3172         real hq_prof(nlev_amma)
    3173         real lat_prof,sens_prof
    3174 ! local:
    3175         integer it_amma1, it_amma2,k
    3176         real timeit,time_amma1,time_amma2,frac
    3177 
    3178 
    3179         if (forcing_type.eq.6) then
    3180 ! Check that initial day of the simulation consistent with AMMA case:
    3181        if (annee_ref.ne.2006) then
    3182         print*,'Pour AMMA, annee_ref doit etre 2006'
    3183         print*,'Changer annee_ref dans run.def'
    3184         stop
    3185        endif
    3186        if (annee_ref.eq.2006 .and. day1.lt.day_ini_amma) then
    3187         print*,'AMMA a débuté le 10 juillet 2006',day1,day_ini_amma
    3188         print*,'Changer dayref dans run.def'
    3189         stop
    3190        endif
    3191        if (annee_ref.eq.2006 .and. day1.gt.day_ini_amma+1) then
    3192         print*,'AMMA a fini le 11 juillet'
    3193         print*,'Changer dayref ou nday dans run.def'
    3194         stop
    3195        endif
    3196        endif
    3197 
    3198 ! Determine timestep relative to the 1st day of AMMA:
    3199 !       timeit=(day-day1)*86400.
    3200 !       if (annee_ref.eq.1992) then
    3201 !        timeit=(day-day_ini_toga)*86400.
    3202 !       else
    3203 !        timeit=(day+61.-1.)*86400. ! 61 days between Nov01 and Dec31 1992
    3204 !       endif
    3205       timeit=(day-day_ini_amma)*86400
    3206 
    3207 ! Determine the closest observation times:
    3208 !       it_amma1=INT(timeit/dt_amma)+1
    3209 !       it_amma2=it_amma1 + 1
    3210 !       time_amma1=(it_amma1-1)*dt_amma
    3211 !       time_amma2=(it_amma2-1)*dt_amma
    3212 
    3213        it_amma1=INT(timeit/dt_amma)+1
    3214        IF (it_amma1 .EQ. nt_amma) THEN
    3215        it_amma2=it_amma1
    3216        ELSE
    3217        it_amma2=it_amma1 + 1
    3218        ENDIF
    3219        time_amma1=(it_amma1-1)*dt_amma
    3220        time_amma2=(it_amma2-1)*dt_amma
    3221 
    3222        if (it_amma1 .gt. nt_amma) then
    3223         write(*,*) 'PB-stop: day, it_amma1, it_amma2, timeit: '            &
    3224      &        ,day,day_ini_amma,it_amma1,it_amma2,timeit/86400.
    3225         stop
    3226        endif
    3227 
    3228 ! time interpolation:
    3229        frac=(time_amma2-timeit)/(time_amma2-time_amma1)
    3230        frac=max(frac,0.0)
    3231 
    3232        lat_prof = lat_amma(it_amma2)                                       &
    3233      &          -frac*(lat_amma(it_amma2)-lat_amma(it_amma1))
    3234        sens_prof = sens_amma(it_amma2)                                     &
    3235      &          -frac*(sens_amma(it_amma2)-sens_amma(it_amma1))
    3236 
    3237        do k=1,nlev_amma
    3238         vitw_prof(k) = vitw_amma(k,it_amma2)                               &
    3239      &          -frac*(vitw_amma(k,it_amma2)-vitw_amma(k,it_amma1))
    3240         ht_prof(k) = ht_amma(k,it_amma2)                                   &
    3241      &          -frac*(ht_amma(k,it_amma2)-ht_amma(k,it_amma1))
    3242         hq_prof(k) = hq_amma(k,it_amma2)                                   &
    3243      &          -frac*(hq_amma(k,it_amma2)-hq_amma(k,it_amma1))
    3244         enddo
    3245 
    3246         return
    3247         END
    32482911
    32492912!=====================================================================

  • LMDZ5/trunk/libf/phylmd/1D_decl_cases.h

    r2019 r2117  
     1#include "netcdf.inc"
     2
    13! Declarations specifiques au cas Toga
    24        character*80 :: fich_toga
    … …  
    7981
    8082
    81 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    82 !Declarations specifiques au cas AMMA
    83         character*80 :: fich_amma
    84 ! Option du cas AMMA ou on impose la discretisation verticale (Ap,Bp)
    85         integer nlev_amma, nt_amma
    86 !       parameter (nlev_amma=29, nt_amma=48)  ! Fleur, juillet 2012
    87         parameter (nlev_amma=36, nt_amma=48)  ! Romain, octobre 2012
    88 !       parameter (nlev_amma=26, nt_amma=48)  ! Test MPL feverier 2013
    89         integer year_ini_amma, day_ini_amma, mth_ini_amma
    90         real heure_ini_amma
    91         real day_ju_ini_amma   ! Julian day of amma first day
    92         parameter (year_ini_amma=2006)
    93         parameter (mth_ini_amma=7)
    94         parameter (day_ini_amma=10)  ! 10 = 10Juil2006
    95         parameter (heure_ini_amma=0.) !0h en secondes
    96         real dt_amma
    97         parameter (dt_amma=1800.)
    9883
    99 !profils initiaux:
    100         real plev_amma(nlev_amma)
    101        
    102         real z_amma(nlev_amma)
    103         real th_amma(nlev_amma),q_amma(nlev_amma)
    104         real u_amma(nlev_amma)
    105         real v_amma(nlev_amma)
    106 
    107         real th_ammai(nlev_amma),q_ammai(nlev_amma)
    108         real u_ammai(nlev_amma)
    109         real v_ammai(nlev_amma)
    110         real vitw_ammai(nlev_amma)
    111         real ht_ammai(nlev_amma)
    112         real hq_ammai(nlev_amma)
    113         real vt_ammai(nlev_amma)
    114         real vq_ammai(nlev_amma)
    115        
    116 !forcings
    117         real ht_amma(nlev_amma,nt_amma)
    118         real hq_amma(nlev_amma,nt_amma)
    119         real vitw_amma(nlev_amma,nt_amma)
    120         real lat_amma(nt_amma),sens_amma(nt_amma)
    121 
    122 !champs interpoles
    123         real vitw_profamma(nlev_amma)
    124         real ht_profamma(nlev_amma)
    125         real hq_profamma(nlev_amma)
    126         real lat_profamma,sens_profamma
    127         real vt_profamma(nlev_amma)
    128         real vq_profamma(nlev_amma)
    129         real th_profamma(nlev_amma)
    130         real q_profamma(nlev_amma)
    131         real u_profamma(nlev_amma)
    132         real v_profamma(nlev_amma)
    133 
    134 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    13584!Declarations specifiques au cas FIRE
    13685        character*80 :: fich_fire

  • LMDZ5/trunk/libf/phylmd/1D_read_forc_cases.h

    r2019 r2117  
    290290
    291291      if (forcing_amma) then
    292 !read AMMA forcings
    293       fich_amma='amma.nc'
    294       call read_amma(fich_amma,nlev_amma,nt_amma                            &
    295      &     ,z_amma,plev_amma,th_amma,q_amma,u_amma,v_amma,vitw_amma         &
    296      &     ,ht_amma,hq_amma,sens_amma,lat_amma)
     292
     293      call read_1D_cases
    297294
    298295      write(*,*) 'Forcing AMMA lu'

  • LMDZ5/trunk/libf/phylmd/lmdz1d.F90

    r2040 r2117  
    2121      USE indice_sol_mod
    2222      USE phyaqua_mod
     23      USE mod_1D_cases_read
    2324
    2425      implicit none
Note: See TracChangeset for help on using the changeset viewer.