Ignore:
Timestamp:
Jan 11, 2013, 10:19:19 AM (12 years ago)
Author:
Laurent Fairhead
Message:

Version testing basée sur la r1706

Testing release based on r1706

Location:
LMDZ5/branches/testing
Files:
5 deleted
16 edited
8 copied

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/phylmd/calcul_STDlev.h

    r1418 r1707  
    22c $Header$
    33c
    4 c
    54cIM on initialise les variables
     5c
     6        missing_val=nf90_fill_real
     7c
     8cIM freq_moyNMC = frequences auxquelles on moyenne les champs accumules
     9cIM               sur les niveaux de pression standard du NMC
     10      DO n=1, nout
     11       freq_moyNMC(n)=freq_outNMC(n)/freq_calNMC(n)
     12      ENDDO
    613c
    714        CALL ini_undefSTD(itap,freq_outNMC)
    … …  
    157164     $     lwup,LWup200)
    158165c
     166      twriteSTD(:,:,1)=tsumSTD(:,:,1)
     167      qwriteSTD(:,:,1)=qsumSTD(:,:,1)
     168      rhwriteSTD(:,:,1)=rhsumSTD(:,:,1)
     169      phiwriteSTD(:,:,1)=phisumSTD(:,:,1)
     170      uwriteSTD(:,:,1)=usumSTD(:,:,1)
     171      vwriteSTD(:,:,1)=vsumSTD(:,:,1)
     172      wwriteSTD(:,:,1)=wsumSTD(:,:,1)
     173
     174      twriteSTD(:,:,2)=tsumSTD(:,:,2)
     175      qwriteSTD(:,:,2)=qsumSTD(:,:,2)
     176      rhwriteSTD(:,:,2)=rhsumSTD(:,:,2)
     177      phiwriteSTD(:,:,2)=phisumSTD(:,:,2)
     178      uwriteSTD(:,:,2)=usumSTD(:,:,2)
     179      vwriteSTD(:,:,2)=vsumSTD(:,:,2)
     180      wwriteSTD(:,:,2)=wsumSTD(:,:,2)
     181
     182      twriteSTD(:,:,3)=tlevSTD(:,:)
     183      qwriteSTD(:,:,3)=qlevSTD(:,:)
     184      rhwriteSTD(:,:,3)=rhlevSTD(:,:)
     185      phiwriteSTD(:,:,3)=philevSTD(:,:)
     186      uwriteSTD(:,:,3)=ulevSTD(:,:)
     187      vwriteSTD(:,:,3)=vlevSTD(:,:)
     188      wwriteSTD(:,:,3)=wlevSTD(:,:)
     189
     190      twriteSTD(:,:,4)=tlevSTD(:,:)
     191      qwriteSTD(:,:,4)=qlevSTD(:,:)
     192      rhwriteSTD(:,:,4)=rhlevSTD(:,:)
     193      phiwriteSTD(:,:,4)=philevSTD(:,:)
     194      uwriteSTD(:,:,4)=ulevSTD(:,:)
     195      vwriteSTD(:,:,4)=vlevSTD(:,:)
     196      wwriteSTD(:,:,4)=wlevSTD(:,:)
     197c
     198cIM initialisation 5eme fichier de sortie
     199      twriteSTD(:,:,5)=tlevSTD(:,:)
     200      qwriteSTD(:,:,5)=qlevSTD(:,:)
     201      rhwriteSTD(:,:,5)=rhlevSTD(:,:)
     202      phiwriteSTD(:,:,5)=philevSTD(:,:)
     203      uwriteSTD(:,:,5)=ulevSTD(:,:)
     204      vwriteSTD(:,:,5)=vlevSTD(:,:)
     205      wwriteSTD(:,:,5)=wlevSTD(:,:)
     206c
     207cIM initialisation 6eme fichier de sortie
     208      twriteSTD(:,:,6)=tlevSTD(:,:)
     209      qwriteSTD(:,:,6)=qlevSTD(:,:)
     210      rhwriteSTD(:,:,6)=rhlevSTD(:,:)
     211      phiwriteSTD(:,:,6)=philevSTD(:,:)
     212      uwriteSTD(:,:,6)=ulevSTD(:,:)
     213      vwriteSTD(:,:,6)=vlevSTD(:,:)
     214      wwriteSTD(:,:,6)=wlevSTD(:,:)
     215cIM for NMC files
     216      DO n=1, nlevSTD3
     217       DO k=1, nlevSTD
     218        if(rlevSTD3(n).EQ.rlevSTD(k)) THEN
     219         twriteSTD3(:,n)=tlevSTD(:,k)
     220         qwriteSTD3(:,n)=qlevSTD(:,k)
     221         rhwriteSTD3(:,n)=rhlevSTD(:,k)
     222         phiwriteSTD3(:,n)=philevSTD(:,k)
     223         uwriteSTD3(:,n)=ulevSTD(:,k)
     224         vwriteSTD3(:,n)=vlevSTD(:,k)
     225         wwriteSTD3(:,n)=wlevSTD(:,k)
     226        endif !rlevSTD3(n).EQ.rlevSTD(k)
     227       ENDDO
     228      ENDDO
     229c
     230      DO n=1, nlevSTD8
     231       DO k=1, nlevSTD
     232        if(rlevSTD8(n).EQ.rlevSTD(k)) THEN
     233         tnondefSTD8(:,n)=tnondef(:,k,2)
     234         twriteSTD8(:,n)=tsumSTD(:,k,2)
     235         qwriteSTD8(:,n)=qsumSTD(:,k,2)
     236         rhwriteSTD8(:,n)=rhsumSTD(:,k,2)
     237         phiwriteSTD8(:,n)=phisumSTD(:,k,2)
     238         uwriteSTD8(:,n)=usumSTD(:,k,2)
     239         vwriteSTD8(:,n)=vsumSTD(:,k,2)
     240         wwriteSTD8(:,n)=wsumSTD(:,k,2)
     241        endif !rlevSTD8(n).EQ.rlevSTD(k)
     242       ENDDO
     243      ENDDO

  • LMDZ5/branches/testing/libf/phylmd/change_srf_frac_mod.F90

    r1454 r1707  
    1212
    1313  SUBROUTINE change_srf_frac(itime, dtime, jour, &
    14        pctsrf, alb1, alb2, tsurf, u10m, v10m, pbl_tke)
     14       pctsrf, alb1, alb2, tsurf, ustar, u10m, v10m, pbl_tke)
    1515!
    1616! This subroutine is called from physiq.F at each timestep.
    … …  
    4646    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: alb2   ! albedo second interval in SW spektrum
    4747    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: tsurf
     48    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: ustar
    4849    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: u10m
    4950    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: v10m
    … …  
    150151!
    151152!****************************************************************************************
    152        CALL pbl_surface_newfrac(itime, pctsrf, pctsrf_old, tsurf, alb1, alb2, u10m, v10m, pbl_tke)
     153       CALL pbl_surface_newfrac(itime, pctsrf, pctsrf_old, tsurf, alb1, alb2, ustar, u10m, v10m, pbl_tke)
    153154
    154155    ELSE

  • LMDZ5/branches/testing/libf/phylmd/iniphysiq.F

    r1403 r1707  
    88     $           pdayref,ptimestep,
    99     $           plat,plon,parea,pcu,pcv,
    10      $           prad,pg,pr,pcpp)
    11       USE dimphy
    12       USE mod_grid_phy_lmdz
    13       USE mod_phys_lmdz_para
    14       USE comgeomphy
     10     $           prad,pg,pr,pcpp,iflag_phys)
     11      USE dimphy, only : klev
     12      USE mod_grid_phy_lmdz, only : klon_glo
     13      USE mod_phys_lmdz_para, only : klon_omp,klon_omp_begin,
     14     &                               klon_omp_end,klon_mpi_begin
     15      USE comgeomphy, only : airephy,cuphy,cvphy,rlond,rlatd
    1516
    1617      IMPLICIT NONE
    … …  
    1819c=======================================================================
    1920c
    20 c   subject:
    21 c   --------
     21c   Initialisation of the physical constants and some positional and
     22c   geometrical arrays for the physics
    2223c
    23 c   Initialisation for the physical parametrisations of the LMD
    24 c   martian atmospheric general circulation modele.
    25 c
    26 c   author: Frederic Hourdin 15 / 10 /93
    27 c   -------
    28 c
    29 c   arguments:
    30 c   ----------
    31 c
    32 c   input:
    33 c   ------
    3424c
    3525c    ngrid                 Size of the horizontal grid.
    … …  
    3727c    nlayer                Number of vertical layers.
    3828c    pdayref               Day of reference for the simulation
    39 c    firstcall             True at the first call
    40 c    lastcall              True at the last call
    41 c    pday                  Number of days counted from the North. Spring
    42 c                          equinoxe.
    4329c
    4430c=======================================================================
    45 c
    46 c-----------------------------------------------------------------------
    47 c   declarations:
    48 c   -------------
    4931 
    5032cym#include "dimensions.h"
    … …  
    5234cym#include "comgeomphy.h"
    5335#include "YOMCST.h"
    54       REAL prad,pg,pr,pcpp,punjours
    55  
    56       INTEGER ngrid,nlayer
    57       REAL plat(ngrid),plon(ngrid),parea(klon_glo)
    58       REAL pcu(klon_glo),pcv(klon_glo)
    59       INTEGER pdayref
    60       INTEGER :: ibegin,iend,offset
    61  
    62       REAL ptimestep
     36#include "iniprint.h"
     37
     38      REAL,INTENT(IN) :: prad ! radius of the planet (m)
     39      REAL,INTENT(IN) :: pg ! gravitational acceleration (m/s2)
     40      REAL,INTENT(IN) :: pr ! ! reduced gas constant R/mu
     41      REAL,INTENT(IN) :: pcpp ! specific heat Cp
     42      REAL,INTENT(IN) :: punjours ! length (in s) of a standard day
     43      INTEGER,INTENT(IN) :: ngrid ! number of horizontal grid points in the physics
     44      INTEGER,INTENT(IN) :: nlayer ! number of atmospheric layers
     45      REAL,INTENT(IN) :: plat(ngrid) ! latitudes of the physics grid
     46      REAL,INTENT(IN) :: plon(ngrid) ! longitudes of the physics grid
     47      REAL,INTENT(IN) :: parea(klon_glo) ! area (m2)
     48      REAL,INTENT(IN) :: pcu(klon_glo) ! cu coeff. (u_covariant = cu * u)
     49      REAL,INTENT(IN) :: pcv(klon_glo) ! cv coeff. (v_covariant = cv * v)
     50      INTEGER,INTENT(IN) :: pdayref ! reference day of for the simulation
     51      REAL,INTENT(IN) :: ptimestep !physics time step (s)
     52      INTEGER,INTENT(IN) :: iflag_phys ! type of physics to be called
     53
     54      INTEGER :: ibegin,iend,offset
    6355      CHARACTER (LEN=20) :: modname='iniphysiq'
    6456      CHARACTER (LEN=80) :: abort_message
    6557 
    6658      IF (nlayer.NE.klev) THEN
    67          PRINT*,'STOP in inifis'
    68          PRINT*,'Probleme de dimensions :'
    69          PRINT*,'nlayer     = ',nlayer
    70          PRINT*,'klev   = ',klev
     59         write(lunout,*) 'STOP in ',trim(modname)
     60         write(lunout,*) 'Problem with dimensions :'
     61         write(lunout,*) 'nlayer     = ',nlayer
     62         write(lunout,*) 'klev   = ',klev
    7163         abort_message = ''
    7264         CALL abort_gcm (modname,abort_message,1)
    … …  
    7466
    7567      IF (ngrid.NE.klon_glo) THEN
    76          PRINT*,'STOP in inifis'
    77          PRINT*,'Probleme de dimensions :'
    78          PRINT*,'ngrid     = ',ngrid
    79          PRINT*,'klon   = ',klon_glo
     68         write(lunout,*) 'STOP in ',trim(modname)
     69         write(lunout,*) 'Problem with dimensions :'
     70         write(lunout,*) 'ngrid     = ',ngrid
     71         write(lunout,*) 'klon   = ',klon_glo
    8072         abort_message = ''
    8173         CALL abort_gcm (modname,abort_message,1)
    8274      ENDIF
    83 c$OMP PARALLEL PRIVATE(ibegin,iend)
    84 c$OMP+         SHARED(parea,pcu,pcv,plon,plat)
     75
     76!$OMP PARALLEL PRIVATE(ibegin,iend)
     77!$OMP+         SHARED(parea,pcu,pcv,plon,plat)
    8578     
    8679      offset=klon_mpi_begin-1
    … …  
    9285      rlatd(1:klon_omp)=plat(offset+klon_omp_begin:offset+klon_omp_end)
    9386
     87      ! suphel => initialize some physical constants (orbital parameters,
     88      !           geoid, gravity, thermodynamical constants, etc.) in the
     89      !           physics
    9490      call suphel
     91     
     92!$OMP END PARALLEL
    9593
    96 c$OMP END PARALLEL
     94      ! check that physical constants set in 'suphel' are coherent
     95      ! with values set in the dynamics:
     96      if (RDAY.ne.punjours) then
     97        write(lunout,*) "iniphysiq: length of day discrepancy!!!"
     98        write(lunout,*) "  in the dynamics punjours=",punjours
     99        write(lunout,*) "   but in the physics RDAY=",RDAY
     100        if (abs(RDAY-punjours).gt.0.01) then
     101          ! stop here if the relative difference is more than 1%
     102          abort_message = 'length of day discrepancy'
     103          CALL abort_gcm (modname,abort_message,1)
     104        endif
     105      endif
     106      if (RG.ne.pg) then
     107        write(lunout,*) "iniphysiq: gravity discrepancy !!!"
     108        write(lunout,*) "     in the dynamics pg=",pg
     109        write(lunout,*) "  but in the physics RG=",RG
     110        if (abs(RG-pg).gt.0.01) then
     111          ! stop here if the relative difference is more than 1%
     112          abort_message = 'gravity discrepancy'
     113          CALL abort_gcm (modname,abort_message,1)
     114        endif
     115      endif
     116      if (RA.ne.prad) then
     117        write(lunout,*) "iniphysiq: planet radius discrepancy !!!"
     118        write(lunout,*) "   in the dynamics prad=",prad
     119        write(lunout,*) "  but in the physics RA=",RA
     120        if (abs(RA-prad).gt.0.01) then
     121          ! stop here if the relative difference is more than 1%
     122          abort_message = 'planet radius discrepancy'
     123          CALL abort_gcm (modname,abort_message,1)
     124        endif
     125      endif
     126      if (RD.ne.pr) then
     127        write(lunout,*)"iniphysiq: reduced gas constant discrepancy !!!"
     128        write(lunout,*)"     in the dynamics pr=",pr
     129        write(lunout,*)"  but in the physics RD=",RD
     130        if (abs(RD-pr).gt.0.01) then
     131          ! stop here if the relative difference is more than 1%
     132          abort_message = 'reduced gas constant discrepancy'
     133          CALL abort_gcm (modname,abort_message,1)
     134        endif
     135      endif
     136      if (RCPD.ne.pcpp) then
     137        write(lunout,*)"iniphysiq: specific heat discrepancy !!!"
     138        write(lunout,*)"     in the dynamics pcpp=",pcpp
     139        write(lunout,*)"  but in the physics RCPD=",RCPD
     140        if (abs(RCPD-pcpp).gt.0.01) then
     141          ! stop here if the relative difference is more than 1%
     142          abort_message = 'specific heat discrepancy'
     143          CALL abort_gcm (modname,abort_message,1)
     144        endif
     145      endif
    97146
    98       print*,'ATTENTION !!! TRAVAILLER SUR INIPHYSIQ'
    99       print*,'CONTROLE DES LATITUDES, LONGITUDES, PARAMETRES ...'
     147! Additional initializations for aquaplanets
     148!$OMP PARALLEL
     149      if (iflag_phys>=100) then
     150        call iniaqua(klon_omp,rlatd,rlond,iflag_phys)
     151      endif
     152!$OMP END PARALLEL
    100153
    101       RETURN
    102 9999  CONTINUE
    103       abort_message ='Cette version demande les fichier rnatur.dat
    104      & et surf.def'
    105       CALL abort_gcm (modname,abort_message,1)
     154!      RETURN
     155!9999  CONTINUE
     156!      abort_message ='Cette version demande les fichier rnatur.dat
     157!     & et surf.def'
     158!      CALL abort_gcm (modname,abort_message,1)
    106159
    107160      END

  • LMDZ5/branches/testing/libf/phylmd/iophy.F90

    r1539 r1707  
    5151   
    5252!$OMP MASTER 
    53     ALLOCATE(io_lat(jjm+1-1/iim))
     53    ALLOCATE(io_lat(jjm+1-1/(iim*jjm)))
    5454    io_lat(1)=rlat_glo(1)
    55     io_lat(jjm+1-1/iim)=rlat_glo(klon_glo)
    56     IF (iim > 1) then
     55    io_lat(jjm+1-1/(iim*jjm))=rlat_glo(klon_glo)
     56    IF ((iim*jjm) > 1) then
    5757      DO i=2,jjm
    5858        io_lat(i)=rlat_glo(2+(i-2)*iim)
    … …  
    6161
    6262    ALLOCATE(io_lon(iim))
    63     io_lon(:)=rlon_glo(2-1/iim:iim+1-1/iim)
     63    io_lon(:)=rlon_glo(2-1/(iim*jjm):iim+1-1/(iim*jjm))
    6464
    6565    ddid=(/ 1,2 /)
    66     dsg=(/ iim, jjm+1-1/iim /)
     66    dsg=(/ iim, jjm+1-1/(iim*jjm) /)
    6767    dsl=(/ iim, jj_nb /)
    6868    dpf=(/ 1,jj_begin /)
    … …  
    8989  include 'dimensions.h'   
    9090    real,dimension(iim),intent(in) :: lon
    91     real,dimension(jjm+1-1/iim),intent(in) :: lat
     91    real,dimension(jjm+1-1/(iim*jjm)),intent(in) :: lat
    9292
    9393    INTEGER,DIMENSION(2) :: ddid
    … …  
    100100
    101101!$OMP MASTER 
    102     allocate(io_lat(jjm+1-1/iim))
     102    allocate(io_lat(jjm+1-1/(iim*jjm)))
    103103    io_lat(:)=lat(:)
    104104    allocate(io_lon(iim))
    … …  
    106106   
    107107    ddid=(/ 1,2 /)
    108     dsg=(/ iim, jjm+1-1/iim /)
     108    dsg=(/ iim, jjm+1-1/(iim*jjm) /)
    109109    dsl=(/ iim, jj_nb /)
    110110    dpf=(/ 1,jj_begin /)
    … …  
    234234
    235235       CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon_glo,zx_lon)
    236        if (iim.gt.1) then
     236       if ((iim*jjm).gt.1) then
    237237       DO i = 1, iim
    238238         zx_lon(i,1) = rlon_glo(i+1)

  • LMDZ5/branches/testing/libf/phylmd/mod_grid_phy_lmdz.F90

    r1001 r1707  
    11!
    2 !$Header$
     2!$Id $
    33!
    44MODULE mod_grid_phy_lmdz
     5
     6  PUBLIC
     7  PRIVATE :: grid1dTo2d_glo_igen, grid1dTo2d_glo_rgen, grid1dTo2d_glo_lgen, &
     8             grid2dTo1d_glo_igen, grid2dTo1d_glo_rgen, grid2dTo1d_glo_lgen
     9 
    510  INTEGER,SAVE :: nbp_lon  ! == iim
    611  INTEGER,SAVE :: nbp_lat  ! == jjmp1
    … …  
    271276  END SUBROUTINE grid2dTo1d_glo_l3
    272277
    273 END MODULE mod_grid_phy_lmdz
    274 
    275 
     278!----------------------------------------------------------------
     279!  Generic (private) fonctions
     280!----------------------------------------------------------------
    276281 
    277282  SUBROUTINE grid1dTo2d_glo_igen(VarIn,VarOut,dimsize)
    278     USE mod_grid_phy_lmdz
     283
    279284    IMPLICIT NONE
    280285
    … …  
    311316
    312317  SUBROUTINE grid1dTo2d_glo_rgen(VarIn,VarOut,dimsize)
    313     USE mod_grid_phy_lmdz
     318
    314319    IMPLICIT NONE
    315320
    … …  
    345350
    346351  SUBROUTINE grid1dTo2d_glo_lgen(VarIn,VarOut,dimsize)
    347     USE mod_grid_phy_lmdz
     352
    348353    IMPLICIT NONE
    349354   
    … …  
    379384 
    380385  SUBROUTINE grid2dTo1d_glo_igen(VarIn,VarOut,dimsize)
    381     USE mod_grid_phy_lmdz
     386
    382387    IMPLICIT NONE
    383388
    … …  
    402407 
    403408  SUBROUTINE grid2dTo1d_glo_rgen(VarIn,VarOut,dimsize)
    404     USE mod_grid_phy_lmdz
     409
    405410    IMPLICIT NONE
    406411
    … …  
    425430   
    426431  SUBROUTINE grid2dTo1d_glo_lgen(VarIn,VarOut,dimsize)
    427     USE mod_grid_phy_lmdz
     432
    428433    IMPLICIT NONE
    429434
    … …  
    446451   
    447452  END SUBROUTINE grid2dTo1d_glo_lgen   
     453
     454END MODULE mod_grid_phy_lmdz

  • LMDZ5/branches/testing/libf/phylmd/pbl_surface_mod.F90

    r1664 r1707  
    172172       t,         q,         u,        v,             &
    173173       pplay,     paprs,     pctsrf,                  &
    174        ts,        alb1,      alb2,     u10m,  v10m,  &
     174       ts,        alb1,      alb2,ustar, u10m, v10m,  &
    175175       lwdown_m,  cdragh,    cdragm,   zu1,    zv1,   &
    176176       alb1_m,    alb2_m,    zxsens,   zxevap,        &
    … …  
    181181       s_capCL,   s_oliqCL,  s_cteiCL, s_pblT,        &
    182182       s_therm,   s_trmb1,   s_trmb2,  s_trmb3,       &
    183        zxrugs,    zu10m,     zv10m,    fder_print,    &
     183       zxrugs,zustar,zu10m,  zv10m,    fder_print,    &
    184184       zxqsurf,   rh2m,      zxfluxu,  zxfluxv,       &
    185185       rugos_d,   agesno_d,  sollw,    solsw,         &
    … …  
    288288    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: alb1    ! albedo in visible SW interval
    289289    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: alb2    ! albedo in near infra-red SW interval
     290    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: ustar   ! u* (m/s)
    290291    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: u10m    ! u speed at 10m
    291292    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: v10m    ! v speed at 10m
    … …  
    330331    REAL, DIMENSION(klon),        INTENT(OUT)       :: s_trmb3    ! point Omega, mean for each grid point
    331332    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxrugs     ! rugosity at surface (m), mean for each grid point
     333    REAL, DIMENSION(klon),        INTENT(OUT)       :: zustar     ! u*
    332334    REAL, DIMENSION(klon),        INTENT(OUT)       :: zu10m      ! u speed at 10m, mean for each grid point
    333335    REAL, DIMENSION(klon),        INTENT(OUT)       :: zv10m      ! v speed at 10m, mean for each grid point
    … …  
    10191021       t2m(:,nsrf)    = 0.
    10201022       q2m(:,nsrf)    = 0.
     1023       ustar(:,nsrf)   = 0.
    10211024       u10m(:,nsrf)   = 0.
    10221025       v10m(:,nsrf)   = 0.
    1023 
    10241026       pblh(:,nsrf)   = 0.        ! Hauteur de couche limite
    10251027       plcl(:,nsrf)   = 0.        ! Niveau de condensation de la CLA
    … …  
    10691071         
    10701072          ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman
     1073          ustar(i,nsrf)=yustar(j)
    10711074          u10m(i,nsrf)=(yu10m(j) * uzon(j))/SQRT(uzon(j)**2+vmer(j)**2)
    10721075          v10m(i,nsrf)=(yu10m(j) * vmer(j))/SQRT(uzon(j)**2+vmer(j)**2)
     1076
    10731077       END DO
    10741078
    … …  
    11501154    zxtsol(:) = 0.0  ; zxfluxlat(:) = 0.0
    11511155    zt2m(:) = 0.0    ; zq2m(:) = 0.0
    1152     zu10m(:) = 0.0   ; zv10m(:) = 0.0
     1156    zustar(:)=0.0 ; zu10m(:) = 0.0   ; zv10m(:) = 0.0
    11531157    s_pblh(:) = 0.0  ; s_plcl(:) = 0.0
    11541158    s_capCL(:) = 0.0 ; s_oliqCL(:) = 0.0
    … …  
    11721176          zt2m(i)  = zt2m(i)  + t2m(i,nsrf)  * pctsrf(i,nsrf)
    11731177          zq2m(i)  = zq2m(i)  + q2m(i,nsrf)  * pctsrf(i,nsrf)
     1178          zustar(i) = zustar(i) + ustar(i,nsrf) * pctsrf(i,nsrf)
    11741179          zu10m(i) = zu10m(i) + u10m(i,nsrf) * pctsrf(i,nsrf)
    11751180          zv10m(i) = zv10m(i) + v10m(i,nsrf) * pctsrf(i,nsrf)
    … …  
    13051310!****************************************************************************************
    13061311!
    1307   SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, tsurf, alb1, alb2, u10m, v10m, tke)
     1312  SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, tsurf, alb1, alb2, ustar, u10m, v10m, tke)
    13081313
    13091314    ! Give default values where new fraction has appread
    … …  
    13231328    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: tsurf
    13241329    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: alb1, alb2
    1325     REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: u10m, v10m
     1330    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT)        :: ustar,u10m, v10m
    13261331    REAL, DIMENSION(klon,klev+1,nbsrf), INTENT(INOUT) :: tke
    13271332
    … …  
    13691374                alb1(i,nsrf)  = alb1(i,nsrf_comp1)
    13701375                alb2(i,nsrf)  = alb2(i,nsrf_comp1)
     1376                ustar(i,nsrf)  = ustar(i,nsrf_comp1)
    13711377                u10m(i,nsrf)  = u10m(i,nsrf_comp1)
    13721378                v10m(i,nsrf)  = v10m(i,nsrf_comp1)
    … …  
    13831389                alb1(i,nsrf)  = alb1(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + alb1(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
    13841390                alb2(i,nsrf)  = alb2(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + alb2(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
     1391                ustar(i,nsrf)  = ustar(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + ustar(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
    13851392                u10m(i,nsrf)  = u10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + u10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
    13861393                v10m(i,nsrf)  = v10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + v10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)

  • LMDZ5/branches/testing/libf/phylmd/phyaqua.F

    r1530 r1707  
    1616!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1717
    18       use comgeomphy
    19       use dimphy
     18      use comgeomphy, only : rlatd,rlond
     19      use dimphy, only : klon
    2020      use surface_data, only : type_ocean,ok_veget
    2121      use pbl_surface_mod, only : pbl_surface_init
    2222      USE fonte_neige_mod, only : fonte_neige_init
    2323      use phys_state_var_mod
    24       use control_mod
    25 
     24      use control_mod, only : dayref,nday,iphysiq
    2625
    2726      USE IOIPSL
    … …  
    3534#include "dimsoil.h"
    3635#include "indicesol.h"
    37 
    38       integer nlon,iflag_phys
     36#include "temps.h"
     37
     38      integer,intent(in) :: nlon,iflag_phys
    3939cIM ajout latfi, lonfi
    40       REAL, DIMENSION (nlon) :: lonfi, latfi
     40      real,intent(in) :: lonfi(nlon),latfi(nlon)
     41
    4142      INTEGER type_profil,type_aqua
    4243
    … …  
    7172!      integer demih_pas
    7273
    73       integer day_ini
    74 
    7574      CHARACTER*80 ans,file_forctl, file_fordat, file_start
    7675      character*100 file,var
    … …  
    8887      REAL phy_flic(nlon,360)
    8988
    90       integer, save::  read_climoz ! read ozone climatology
     89      integer, save::  read_climoz=0 ! read ozone climatology
    9190
    9291
    … …  
    131130      type_aqua=iflag_phys/100
    132131      type_profil=iflag_phys-type_aqua*100
    133       print*,'type_aqua, type_profil',type_aqua, type_profil
    134 
    135       if (klon.ne.nlon) stop'probleme de dimensions dans iniaqua'
     132      print*,'iniaqua:type_aqua, type_profil',type_aqua, type_profil
     133
     134      if (klon.ne.nlon) then
     135        write(*,*)"iniaqua: klon=",klon," nlon=",nlon
     136        stop'probleme de dimensions dans iniaqua'
     137      endif
    136138      call phys_state_var_init(read_climoz)
    137139
    … …  
    154156
    155157         day_ini=dayref
     158         day_end=day_ini+nday
    156159         airefi=1.
    157160         zcufi=1.
    … …  
    171174      radsol=0.
    172175      qsol_f=10.
    173       CALL getin('albedo',albedo)
     176!      CALL getin('albedo',albedo) ! albedo is set below, depending on type_aqua
    174177      alb_ocean=.true.
    175178      CALL getin('alb_ocean',alb_ocean)
    … …  
    180183      qsol(:)    = qsol_f
    181184      rugsrel = 0.0    ! (rugsrel = rugoro)
     185      rugoro = 0.0
     186      u_ancien = 0.0
     187      v_ancien = 0.0
    182188      agesno  = 50.0
    183189! Relief plat
    … …  
    308314     .     evap, frugs, agesno, tsoil)
    309315
    310         print*,'avant phyredem dans iniaqua'
     316        print*,'iniaqua: before phyredem'
    311317
    312318      falb1=albedo
    … …  
    329335      CALL phyredem ("startphy.nc")
    330336
    331         print*,'apres phyredem'
     337        print*,'iniaqua: after phyredem'
    332338      call phys_state_var_end
    333339
    … …  
    450456      RETURN
    451457      END
     458
     459!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     460
    452461      subroutine writelim
    453462     s   (klon,phy_nat,phy_alb,phy_sst,phy_bil,phy_rug,phy_ice,
    454463     s    phy_fter,phy_foce,phy_flic,phy_fsic)
    455464c
     465      use mod_phys_lmdz_para, only: is_mpi_root,is_omp_root
     466      use mod_grid_phy_lmdz, only : klon_glo
     467      use mod_phys_lmdz_transfert_para, only : gather
    456468!#include "dimensions.h"
    457469!#include "dimphy.h"
    458470#include "netcdf.inc"
    459471 
    460       integer klon
    461       REAL phy_nat(klon,360)
    462       REAL phy_alb(klon,360)
    463       REAL phy_sst(klon,360)
    464       REAL phy_bil(klon,360)
    465       REAL phy_rug(klon,360)
    466       REAL phy_ice(klon,360)
    467       REAL phy_fter(klon,360)
    468       REAL phy_foce(klon,360)
    469       REAL phy_flic(klon,360)
    470       REAL phy_fsic(klon,360)
    471  
     472      integer,intent(in) :: klon
     473      real,intent(in) :: phy_nat(klon,360)
     474      real,intent(in) :: phy_alb(klon,360)
     475      real,intent(in) :: phy_sst(klon,360)
     476      real,intent(in) :: phy_bil(klon,360)
     477      real,intent(in) :: phy_rug(klon,360)
     478      real,intent(in) :: phy_ice(klon,360)
     479      real,intent(in) :: phy_fter(klon,360)
     480      real,intent(in) :: phy_foce(klon,360)
     481      real,intent(in) :: phy_flic(klon,360)
     482      real,intent(in) :: phy_fsic(klon,360)
     483
     484      real :: phy_glo(klon_glo,360) ! temporary variable, to store phy_***(:)
     485                                    ! on the whole physics grid
    472486      INTEGER ierr
    473487      INTEGER dimfirst(3)
    … …  
    480494      INTEGER id_FTER,id_FOCE,id_FSIC,id_FLIC
    481495 
    482       PRINT*, 'Ecriture du fichier limit'
    483 c
    484       ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid)
    485 c
    486       ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 30,
     496      if (is_mpi_root.and.is_omp_root) then
     497     
     498        PRINT*, 'writelim: Ecriture du fichier limit'
     499c
     500        ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid)
     501c
     502        ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 30,
    487503     .                       "Fichier conditions aux limites")
    488       ierr = NF_DEF_DIM (nid, "points_physiques", klon, ndim)
    489       ierr = NF_DEF_DIM (nid, "time", NF_UNLIMITED, ntim)
    490 c
    491       dims(1) = ndim
    492       dims(2) = ntim
     504!!        ierr = NF_DEF_DIM (nid, "points_physiques", klon, ndim)
     505        ierr = NF_DEF_DIM (nid, "points_physiques", klon_glo, ndim)
     506        ierr = NF_DEF_DIM (nid, "time", NF_UNLIMITED, ntim)
     507c
     508        dims(1) = ndim
     509        dims(2) = ntim
    493510c
    494511ccc      ierr = NF_DEF_VAR (nid, "TEMPS", NF_DOUBLE, 1,ntim, id_tim)
    495       ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
    496       ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
     512        ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
     513        ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
    497514     .                        "Jour dans l annee")
    498515ccc      ierr = NF_DEF_VAR (nid, "NAT", NF_DOUBLE, 2,dims, id_NAT)
    499       ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
    500       ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
     516        ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
     517        ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
    501518     .                        "Nature du sol (0,1,2,3)")
    502519ccc      ierr = NF_DEF_VAR (nid, "SST", NF_DOUBLE, 2,dims, id_SST)
    503       ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
    504       ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
     520        ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
     521        ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
    505522     .                        "Temperature superficielle de la mer")
    506523ccc      ierr = NF_DEF_VAR (nid, "BILS", NF_DOUBLE, 2,dims, id_BILS)
    507       ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
    508       ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
     524        ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
     525        ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
    509526     .                        "Reference flux de chaleur au sol")
    510527ccc      ierr = NF_DEF_VAR (nid, "ALB", NF_DOUBLE, 2,dims, id_ALB)
    511       ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
    512       ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
     528        ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
     529        ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
    513530     .                        "Albedo a la surface")
    514531ccc      ierr = NF_DEF_VAR (nid, "RUG", NF_DOUBLE, 2,dims, id_RUG)
    515       ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
    516       ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,
     532        ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
     533        ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,
    517534     .                        "Rugosite")
    518535
    519       ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER)
    520       ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 8,"Frac. Terre")
    521       ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE)
    522       ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 8,"Frac. Terre")
    523       ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC)
    524       ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 8,"Frac. Terre")
    525       ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC)
    526       ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 8,"Frac. Terre")
    527 c
    528       ierr = NF_ENDDEF(nid)
    529 c
    530       DO k = 1, 360
    531 c
    532       debut(1) = 1
    533       debut(2) = k
    534       epais(1) = klon
    535       epais(2) = 1
    536 c
    537       print*,'Instant ',k
    538 #ifdef NC_DOUBLE
    539       print*,'NC DOUBLE'
    540       ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k))
    541       ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais,phy_nat(1,k))
    542       ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k))
    543       ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k))
    544       ierr = NF_PUT_VARA_DOUBLE (nid,id_ALB,debut,epais,phy_alb(1,k))
    545       ierr = NF_PUT_VARA_DOUBLE (nid,id_RUG,debut,epais,phy_rug(1,k))
    546       ierr = NF_PUT_VARA_DOUBLE (nid,id_FTER,debut,epais,phy_fter(1,k))
    547       ierr = NF_PUT_VARA_DOUBLE (nid,id_FOCE,debut,epais,phy_foce(1,k))
    548       ierr = NF_PUT_VARA_DOUBLE (nid,id_FSIC,debut,epais,phy_fsic(1,k))
    549       ierr = NF_PUT_VARA_DOUBLE (nid,id_FLIC,debut,epais,phy_flic(1,k))
    550 #else
    551       print*,'NC PAS DOUBLE'
    552       ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k))
    553       ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais,phy_nat(1,k))
    554       ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k))
    555       ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k))
    556       ierr = NF_PUT_VARA_REAL (nid,id_ALB,debut,epais,phy_alb(1,k))
    557       ierr = NF_PUT_VARA_REAL (nid,id_RUG,debut,epais,phy_rug(1,k))
    558       ierr = NF_PUT_VARA_REAL (nid,id_FTER,debut,epais,phy_fter(1,k))
    559       ierr = NF_PUT_VARA_REAL (nid,id_FOCE,debut,epais,phy_foce(1,k))
    560       ierr = NF_PUT_VARA_REAL (nid,id_FSIC,debut,epais,phy_fsic(1,k))
    561       ierr = NF_PUT_VARA_REAL (nid,id_FLIC,debut,epais,phy_flic(1,k))
    562 
    563 #endif
    564 c
    565       ENDDO
    566 c
    567       ierr = NF_CLOSE(nid)
    568 c
    569       return
     536        ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER)
     537        ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 8,"Frac. Terre")
     538        ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE)
     539        ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 8,"Frac. Terre")
     540        ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC)
     541        ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 8,"Frac. Terre")
     542        ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC)
     543        ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 8,"Frac. Terre")
     544c
     545        ierr = NF_ENDDEF(nid)
     546c
     547
     548! write the 'times'
     549        do k=1,360
     550#ifdef NC_DOUBLE
     551          ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k))
     552#else
     553          ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k))
     554#endif
     555        enddo
     556
     557      endif ! of if (is_mpi_root.and.is_omp_root)
     558
     559! write the fields, after having collected them on master
     560
     561      call gather(phy_nat,phy_glo)
     562      if (is_mpi_root.and.is_omp_root) then
     563#ifdef NC_DOUBLE
     564        ierr=NF_PUT_VAR_DOUBLE(nid,id_NAT,phy_glo)
     565#else
     566        ierr=NF_PUT_VAR_REAL(nid,id_NAT,phy_glo)
     567#endif
     568        if(ierr.ne.NF_NOERR) then
     569          write(*,*) "writelim error with phy_nat"
     570          write(*,*) NF_STRERROR(ierr)
     571        endif
     572      endif
     573
     574      call gather(phy_sst,phy_glo)
     575      if (is_mpi_root.and.is_omp_root) then
     576#ifdef NC_DOUBLE
     577        ierr=NF_PUT_VAR_DOUBLE(nid,id_SST,phy_glo)
     578#else
     579        ierr=NF_PUT_VAR_REAL(nid,id_SST,phy_glo)
     580#endif
     581        if(ierr.ne.NF_NOERR) then
     582          write(*,*) "writelim error with phy_sst"
     583          write(*,*) NF_STRERROR(ierr)
     584        endif
     585      endif
     586
     587      call gather(phy_bil,phy_glo)
     588      if (is_mpi_root.and.is_omp_root) then
     589#ifdef NC_DOUBLE
     590        ierr=NF_PUT_VAR_DOUBLE(nid,id_BILS,phy_glo)
     591#else
     592        ierr=NF_PUT_VAR_REAL(nid,id_BILS,phy_glo)
     593#endif
     594        if(ierr.ne.NF_NOERR) then
     595          write(*,*) "writelim error with phy_bil"
     596          write(*,*) NF_STRERROR(ierr)
     597        endif
     598      endif
     599
     600      call gather(phy_alb,phy_glo)
     601      if (is_mpi_root.and.is_omp_root) then
     602#ifdef NC_DOUBLE
     603        ierr=NF_PUT_VAR_DOUBLE(nid,id_ALB,phy_glo)
     604#else
     605        ierr=NF_PUT_VAR_REAL(nid,id_ALB,phy_glo)
     606#endif
     607        if(ierr.ne.NF_NOERR) then
     608          write(*,*) "writelim error with phy_alb"
     609          write(*,*) NF_STRERROR(ierr)
     610        endif
     611      endif
     612
     613      call gather(phy_rug,phy_glo)
     614      if (is_mpi_root.and.is_omp_root) then
     615#ifdef NC_DOUBLE
     616        ierr=NF_PUT_VAR_DOUBLE(nid,id_RUG,phy_glo)
     617#else
     618        ierr=NF_PUT_VAR_REAL(nid,id_RUG,phy_glo)
     619#endif
     620        if(ierr.ne.NF_NOERR) then
     621          write(*,*) "writelim error with phy_rug"
     622          write(*,*) NF_STRERROR(ierr)
     623        endif
     624      endif
     625
     626      call gather(phy_fter,phy_glo)
     627      if (is_mpi_root.and.is_omp_root) then
     628#ifdef NC_DOUBLE
     629        ierr=NF_PUT_VAR_DOUBLE(nid,id_FTER,phy_glo)
     630#else
     631        ierr=NF_PUT_VAR_REAL(nid,id_FTER,phy_glo)
     632#endif
     633        if(ierr.ne.NF_NOERR) then
     634          write(*,*) "writelim error with phy_fter"
     635          write(*,*) NF_STRERROR(ierr)
     636        endif
     637      endif
     638
     639      call gather(phy_foce,phy_glo)
     640      if (is_mpi_root.and.is_omp_root) then
     641#ifdef NC_DOUBLE
     642        ierr=NF_PUT_VAR_DOUBLE(nid,id_FOCE,phy_glo)
     643#else
     644        ierr=NF_PUT_VAR_REAL(nid,id_FOCE,phy_glo)
     645#endif
     646        if(ierr.ne.NF_NOERR) then
     647          write(*,*) "writelim error with phy_foce"
     648          write(*,*) NF_STRERROR(ierr)
     649        endif
     650      endif
     651
     652      call gather(phy_fsic,phy_glo)
     653      if (is_mpi_root.and.is_omp_root) then
     654#ifdef NC_DOUBLE
     655        ierr=NF_PUT_VAR_DOUBLE(nid,id_FSIC,phy_glo)
     656#else
     657        ierr=NF_PUT_VAR_REAL(nid,id_FSIC,phy_glo)
     658#endif
     659        if(ierr.ne.NF_NOERR) then
     660          write(*,*) "writelim error with phy_fsic"
     661          write(*,*) NF_STRERROR(ierr)
     662        endif
     663      endif
     664
     665      call gather(phy_flic,phy_glo)
     666      if (is_mpi_root.and.is_omp_root) then
     667#ifdef NC_DOUBLE
     668        ierr=NF_PUT_VAR_DOUBLE(nid,id_FLIC,phy_glo)
     669#else
     670        ierr=NF_PUT_VAR_REAL(nid,id_FLIC,phy_glo)
     671#endif
     672        if(ierr.ne.NF_NOERR) then
     673          write(*,*) "writelim error with phy_flic"
     674          write(*,*) NF_STRERROR(ierr)
     675        endif
     676      endif
     677
     678!  close file:
     679      if (is_mpi_root.and.is_omp_root) then
     680        ierr = NF_CLOSE(nid)
     681      endif
     682
    570683      end
     684
     685!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    571686
    572687      SUBROUTINE profil_sst(nlon, rlatd, type_profil, phy_sst)

  • LMDZ5/branches/testing/libf/phylmd/phyetat0.F

    r1665 r1707  
    7676c FH1D
    7777c     real iolat(jjm+1)
    78       real iolat(jjm+1-1/iim)
     78      real iolat(jjm+1-1/(iim*jjm))
    7979c
    8080c Ouvrir le fichier contenant l'etat initial:

  • LMDZ5/branches/testing/libf/phylmd/phys_output_mod.F90

    r1669 r1707  
    8181  type(ctrl_out),save :: o_sicf         = ctrl_out((/ 1, 1, 10, 10, 10, 10 /),'sicf')
    8282  type(ctrl_out),save :: o_q2m          = ctrl_out((/ 1, 1, 1, 5, 10, 10 /),'q2m')
     83  type(ctrl_out),save :: o_ustar        = ctrl_out((/ 1, 1, 1, 5, 10, 10 /),'ustar')
    8384  type(ctrl_out),save :: o_u10m         = ctrl_out((/ 1, 1, 1, 5, 10, 10 /),'u10m')
    8485  type(ctrl_out),save :: o_v10m         = ctrl_out((/ 1, 1, 1, 5, 10, 10 /),'v10m')
    … …  
    8687  type(ctrl_out),save :: o_qsurf        = ctrl_out((/ 1, 10, 10, 10, 10, 10 /),'qsurf')
    8788
     89  type(ctrl_out),save,dimension(4) :: o_ustar_srf     = (/ ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'ustar_ter'), &
     90       ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'ustar_lic'), &
     91       ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'ustar_oce'), &
     92       ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'ustar_sic') /)
    8893  type(ctrl_out),save,dimension(4) :: o_u10m_srf     = (/ ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'u10m_ter'), &
    8994       ctrl_out((/ 10, 6, 10, 10, 10, 10 /),'u10m_lic'), &
    … …  
    585590
    586591  type(ctrl_out),save,allocatable :: o_trac(:)
     592  type(ctrl_out),save,allocatable :: o_trac_cum(:)
    587593
    588594  type(ctrl_out),save :: o_rsu        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'rsu')
    … …  
    719725
    720726    if (.not. allocated(o_trac)) ALLOCATE(o_trac(nqtot))
     727    if (.not. allocated(o_trac_cum)) ALLOCATE(o_trac_cum(nqtot))
    721728
    722729    levmax = (/ klev, klev, klev, klev, klev, klev /)
    … …  
    960967          CALL histdef2d(iff,clef_stations(iff),o_sicf%flag,o_sicf%name, "Sea-ice fraction", "-" )
    961968          CALL histdef2d(iff,clef_stations(iff),o_q2m%flag,o_q2m%name, "Specific humidity 2m", "kg/kg")
     969          CALL histdef2d(iff,clef_stations(iff),o_ustar%flag,o_ustar%name, "Friction velocity", "m/s" )
    962970          CALL histdef2d(iff,clef_stations(iff),o_u10m%flag,o_u10m%name, "Vent zonal 10m", "m/s" )
    963971          CALL histdef2d(iff,clef_stations(iff),o_v10m%flag,o_v10m%name, "Vent meridien 10m", "m/s")
    … …  
    969977          endif
    970978
     979             type_ecri(1) = 'inst(X)'
     980             type_ecri(2) = 'inst(X)'
     981             type_ecri(3) = 'inst(X)'
     982             type_ecri(4) = 'inst(X)'
     983             type_ecri(5) = 'inst(X)'
     984             type_ecri(6) = 'inst(X)'
    971985          CALL histdef2d(iff,clef_stations(iff),o_ndayrain%flag,o_ndayrain%name, "Number of dayrain(liq+sol)", "-")
     986             type_ecri(:) = type_ecri_files(:)
    972987          CALL histdef2d(iff,clef_stations(iff),o_precip%flag,o_precip%name, "Precip Totale liq+sol", "kg/(s*m2)" )
    973988          CALL histdef2d(iff,clef_stations(iff),o_plul%flag,o_plul%name, "Large-scale Precip.", "kg/(s*m2)")
    … …  
    10271042                  o_tsol_srf(nsrf)%flag,o_tsol_srf(nsrf)%name,"Temperature "//clnsurf(nsrf),"K")
    10281043             CALL histdef2d(iff,clef_stations(iff), &
     1044                  o_ustar_srf(nsrf)%flag,o_ustar_srf(nsrf)%name,"Friction velocity "//clnsurf(nsrf),"m/s")
     1045             CALL histdef2d(iff,clef_stations(iff), &
    10291046                  o_u10m_srf(nsrf)%flag,o_u10m_srf(nsrf)%name,"Vent Zonal 10m "//clnsurf(nsrf),"m/s")
    10301047             CALL histdef2d(iff,clef_stations(iff), &
    … …  
    17561773                o_trac(iq-2) = ctrl_out((/ 4, 5, 1, 1, 1, 10 /),tname(iiq))
    17571774                CALL histdef3d (iff,clef_stations(iff), &
    1758                      o_trac(iq-2)%flag,o_trac(iq-2)%name,'Tracer '//ttext(iiq), "-" )
     1775                o_trac(iq-2)%flag,o_trac(iq-2)%name,'Tracer '//ttext(iiq), "-" )
     1776                o_trac_cum(iq-2) = ctrl_out((/ 3, 4, 10, 10, 10, 10 /),'cum'//tname(iiq))
     1777                CALL histdef2d (iff,clef_stations(iff), &
     1778                o_trac_cum(iq-2)%flag,o_trac_cum(iq-2)%name,'Cumulated tracer '//ttext(iiq), "-" )
    17591779             ENDDO
    17601780          ENDIF

  • LMDZ5/branches/testing/libf/phylmd/phys_output_write.h

    r1669 r1707  
    101101      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
    102102     $o_q2m%name,itau_w,zq2m)
     103       ENDIF
     104
     105       IF (o_ustar%flag(iff)<=lev_files(iff)) THEN
     106      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     107     $o_ustar%name,itau_w,zustar)
    103108       ENDIF
    104109
    … …  
    437442     $      zx_tmp_fi2d)
    438443        ENDIF
     444
     445      IF (o_ustar_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
     446      zx_tmp_fi2d(1 : klon) = ustar(1 : klon, nsrf)
     447      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     448     $o_ustar_srf(nsrf)%name,
     449     $                 itau_w,zx_tmp_fi2d)
     450      ENDIF
    439451
    440452      IF (o_u10m_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
    … …  
    22482260       ENDIF
    22492261         ENDDO
     2262         DO iq=3,nqtot
     2263       IF (o_trac_cum(iq-2)%flag(iff)<=lev_files(iff)) THEN
     2264         zx_tmp_fi2d=0.
     2265         do k=1,klev
     2266            zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*qx(:,k,iq)
     2267         enddo
     2268         CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     2269     s                  o_trac_cum(iq-2)%name,itau_w,zx_tmp_fi2d)
     2270
     2271       ENDIF
     2272         ENDDO
    22502273        endif
    22512274

  • LMDZ5/branches/testing/libf/phylmd/phys_state_var_mod.F90

    r1669 r1707  
    326326      REAL,SAVE,ALLOCATABLE :: newsst(:)
    327327!$OMP THREADPRIVATE(newsst)
    328       REAL,SAVE,ALLOCATABLE :: u10m(:,:), v10m(:,:)
    329 !$OMP THREADPRIVATE(u10m,v10m)
     328      REAL,SAVE,ALLOCATABLE :: ustar(:,:),u10m(:,:), v10m(:,:)
     329!$OMP THREADPRIVATE(ustar,u10m,v10m)
    330330!
    331331! ok_ade=T -ADE=topswad-topsw
    … …  
    496496      ALLOCATE(rlonPOS(klon))
    497497      ALLOCATE(newsst(klon))
    498       ALLOCATE(u10m(klon,nbsrf), v10m(klon,nbsrf))
     498      ALLOCATE(ustar(klon,nbsrf),u10m(klon,nbsrf), v10m(klon,nbsrf))
    499499      ALLOCATE(topswad(klon), solswad(klon))
    500500      ALLOCATE(topswai(klon), solswai(klon))
    … …  
    606606      deallocate(rlonPOS)
    607607      deallocate(newsst)
    608       deallocate(u10m, v10m)
     608      deallocate(ustar,u10m, v10m)
    609609      deallocate(topswad, solswad)
    610610      deallocate(topswai, solswai)

  • LMDZ5/branches/testing/libf/phylmd/physiq.F

    r1669 r1707  
    178178      save iflag_ratqs
    179179c$OMP THREADPRIVATE(iflag_ratqs)
    180       real facteur,zfratqs1,zfratqs2
     180      real facteur
    181181
    182182      REAL zz,znum,zden
    … …  
    257257c variables a une pression donnee
    258258c
    259       real rlevSTD(nlevSTD)
    260       DATA rlevSTD/100000., 92500., 85000., 70000.,
    261      .60000., 50000., 40000., 30000., 25000., 20000.,
    262      .15000., 10000., 7000., 5000., 3000., 2000., 1000./
    263       SAVE rlevstd
    264 c$OMP THREADPRIVATE(rlevstd)
    265       CHARACTER*4 clevSTD(nlevSTD)
    266       DATA clevSTD/'1000','925 ','850 ','700 ','600 ',
    267      .'500 ','400 ','300 ','250 ','200 ','150 ','100 ',
    268      .'70  ','50  ','30  ','20  ','10  '/
    269       SAVE clevSTD
    270 c$OMP THREADPRIVATE(clevSTD)
     259#include "declare_STDlev.h"
    271260c
    272261      CHARACTER*4 bb2
    273262      CHARACTER*2 bb3
    274 
    275       real twriteSTD(klon,nlevSTD,nfiles)
    276       real qwriteSTD(klon,nlevSTD,nfiles)
    277       real rhwriteSTD(klon,nlevSTD,nfiles)
    278       real phiwriteSTD(klon,nlevSTD,nfiles)
    279       real uwriteSTD(klon,nlevSTD,nfiles)
    280       real vwriteSTD(klon,nlevSTD,nfiles)
    281       real wwriteSTD(klon,nlevSTD,nfiles)
    282 cIM for NMC files
    283       REAL geo500(klon)
    284       real :: rlevSTD3(nlevSTD3)
    285       DATA rlevSTD3/85000., 50000., 25000./
    286       SAVE rlevSTD3
    287 c$OMP THREADPRIVATE(rlevSTD3)
    288       real :: rlevSTD8(nlevSTD8)
    289       DATA rlevSTD8/100000., 85000., 70000., 50000., 25000., 10000.,
    290      $     5000., 1000./
    291       SAVE rlevSTD8
    292 c$OMP THREADPRIVATE(rlevSTD8)
    293       real twriteSTD3(klon,nlevSTD3)
    294       real qwriteSTD3(klon,nlevSTD3)
    295       real rhwriteSTD3(klon,nlevSTD3)
    296       real phiwriteSTD3(klon,nlevSTD3)
    297       real uwriteSTD3(klon,nlevSTD3)
    298       real vwriteSTD3(klon,nlevSTD3)
    299       real wwriteSTD3(klon,nlevSTD3)
    300 c
    301       real tnondefSTD8(klon,nlevSTD8)
    302       real twriteSTD8(klon,nlevSTD8)
    303       real qwriteSTD8(klon,nlevSTD8)
    304       real rhwriteSTD8(klon,nlevSTD8)
    305       real phiwriteSTD8(klon,nlevSTD8)
    306       real uwriteSTD8(klon,nlevSTD8)
    307       real vwriteSTD8(klon,nlevSTD8)
    308       real wwriteSTD8(klon,nlevSTD8)
    309 c
    310 c plevSTD3 END
    311 c
    312 c nout : niveau de output des variables a une pression donnee
    313       logical oknondef(klon,nlevSTD,nout)
    314 c
    315 c les produits uvSTD, vqSTD, .., T2STD sont calcules
    316 c a partir des valeurs instantannees toutes les 6 h
    317 c qui sont moyennees sur le mois
    318263c
    319264#include "radopt.h"
    … …  
    958903      REAL snow_lsc(klon)
    959904c
    960       REAL ratqss(klon,klev),ratqsc(klon,klev)
     905      REAL ratqsc(klon,klev)
    961906      real ratqsbas,ratqshaut,tau_ratqs
    962907      save ratqsbas,ratqshaut,tau_ratqs
    … …  
    1050995      REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D
    1051996      REAL zx_tmp_fi3d1(klon,klev+1) !variable temporaire pour champs 3D (kelvp1)
    1052 c#ifdef histNMC
    1053 cym   A voir plus tard !!!!
    1054 cym      REAL zx_tmp_NC(iim,jjmp1,nlevSTD)
    1055       REAL zx_tmp_fiNC(klon,nlevSTD)
    1056 c#endif
    1057997      REAL(KIND=8) zx_tmp2_fi3d(klon,klev) ! variable temporaire pour champs 3D
    1058998      REAL zx_tmp_2d(iim,jjmp1), zx_tmp_3d(iim,jjmp1,klev)
    1059999      REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1)
    1060 cIM for NMC files
    1061       REAL missing_val
    1062       REAL, SAVE :: freq_moyNMC(nout)
    1063 c$OMP THREADPRIVATE(freq_moyNMC)
    10641000c
    10651001      INTEGER nid_day, nid_mth, nid_ins, nid_mthnmc, nid_daynmc
    … …  
    11371073      REAL q2m(klon,nbsrf)  ! humidite a 2m
    11381074
    1139 cIM: t2m, q2m, u10m, v10m et t2mincels, t2maxcels
     1075cIM: t2m, q2m, ustar, u10m, v10m et t2mincels, t2maxcels
    11401076      REAL zt2m(klon), zq2m(klon)             !temp., hum. 2m moyenne s/ 1 maille
    1141       REAL zu10m(klon), zv10m(klon)           !vents a 10m moyennes s/1 maille
     1077      REAL zustar(klon),zu10m(klon), zv10m(klon)  ! u* et vents a 10m moyennes s/1 maille
    11421078      CHARACTER*40 t2mincels, t2maxcels       !t2m min., t2m max
    11431079      CHARACTER*40 tinst, tave, typeval
    … …  
    12551191      integer iostat
    12561192
    1257 cIM for NMC files
    1258       missing_val=nf90_fill_real
    12591193c======================================================================
    12601194! Gestion calendrier : mise a jour du module phys_cal_mod
    … …  
    13261260      call phys_output_var_init
    13271261      print*, '================================================='
    1328 cIM for NMC files
    1329 cIM freq_moyNMC = frequences auxquelles on moyenne les champs accumules
    1330 cIM               sur les niveaux de pression standard du NMC
    1331       DO n=1, nout
    1332        freq_moyNMC(n)=freq_outNMC(n)/freq_calNMC(n)
    1333       ENDDO
    1334 c
    1335 cIM beg
     1262c
    13361263          dnwd0=0.0
    13371264          ftd=0.0
    … …  
    13811308         lalim_conv(:)=1
    13821309cRC
     1310         ustar(:,:)=0.
    13831311         u10m(:,:)=0.
    13841312         v10m(:,:)=0.
    … …  
    17681696!
    17691697      CALL change_srf_frac(itap, dtime, days_elapsed+1,
    1770      *     pctsrf, falb1, falb2, ftsol, u10m, v10m, pbl_tke)
     1698     *     pctsrf, falb1, falb2, ftsol, ustar, u10m, v10m, pbl_tke)
    17711699
    17721700
    … …  
    20782006     e     t_seri,    q_seri,    u_seri,  v_seri,   
    20792007     e     pplay,     paprs,     pctsrf,           
    2080      +     ftsol,     falb1,     falb2,   u10m,   v10m,
     2008     +     ftsol,     falb1,     falb2,   ustar, u10m,   v10m,
    20812009     s     sollwdown, cdragh,    cdragm,  u1,    v1,
    20822010     s     albsol1,   albsol2,   sens,    evap, 
    … …  
    20872015     d     s_capCL,   s_oliqCL,  s_cteiCL,s_pblT,
    20882016     d     s_therm,   s_trmb1,   s_trmb2, s_trmb3,
    2089      d     zxrugs,    zu10m,     zv10m,   fder,
     2017     d     zxrugs,    zustar, zu10m,     zv10m,   fder,
    20902018     d     zxqsurf,   rh2m,      zxfluxu, zxfluxv,
    20912019     d     frugs,     agesno,    fsollw,  fsolsw,
    … …  
    28162744
    28172745c-------------------------------------------------------------------------
    2818 c  Caclul des ratqs
    2819 c-------------------------------------------------------------------------
    2820 
    2821 c      print*,'calcul des ratqs'
    2822 c   ratqs convectifs a l'ancienne en fonction de q(z=0)-q / q
    2823 c   ----------------
    2824 c   on ecrase le tableau ratqsc calcule par clouds_gno
    2825       if (iflag_cldcon.eq.1) then
    2826          do k=1,klev
    2827          do i=1,klon
    2828             if(ptconv(i,k)) then
    2829               ratqsc(i,k)=ratqsbas
    2830      s        +fact_cldcon*(q_seri(i,1)-q_seri(i,k))/q_seri(i,k)
    2831             else
    2832                ratqsc(i,k)=0.
    2833             endif
    2834          enddo
    2835          enddo
    2836 
    2837 c-----------------------------------------------------------------------
    2838 c  par nversion de la fonction log normale
    2839 c-----------------------------------------------------------------------
    2840       else if (iflag_cldcon.eq.4) then
    2841          ptconvth(:,:)=.false.
    2842          ratqsc(:,:)=0.
    2843          if(prt_level.ge.9) print*,'avant clouds_gno thermique'
    2844          call clouds_gno
    2845      s   (klon,klev,q_seri,zqsat,clwcon0th,ptconvth,ratqsc,rnebcon0th)
    2846          if(prt_level.ge.9) print*,' CLOUDS_GNO OK'
    2847        
    2848        endif
    2849 
    2850 c   ratqs stables
    2851 c   -------------
    2852 
    2853       if (iflag_ratqs.eq.0) then
    2854 
    2855 ! Le cas iflag_ratqs=0 correspond a la version IPCC 2005 du modele.
    2856          do k=1,klev
    2857             do i=1, klon
    2858                ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*
    2859      s         min((paprs(i,1)-pplay(i,k))/(paprs(i,1)-30000.),1.)
    2860             enddo
    2861          enddo
    2862 
    2863 ! Pour iflag_ratqs=1 ou 2, le ratqs est constant au dessus de
    2864 ! 300 hPa (ratqshaut), varie lineariement en fonction de la pression
    2865 ! entre 600 et 300 hPa et est soit constant (ratqsbas) pour iflag_ratqs=1
    2866 ! soit lineaire (entre 0 a la surface et ratqsbas) pour iflag_ratqs=2
    2867 ! Il s'agit de differents tests dans la phase de reglage du modele
    2868 ! avec thermiques.
    2869 
    2870       else if (iflag_ratqs.eq.1) then
    2871 
    2872          do k=1,klev
    2873             do i=1, klon
    2874                if (pplay(i,k).ge.60000.) then
    2875                   ratqss(i,k)=ratqsbas
    2876                else if ((pplay(i,k).ge.30000.).and.
    2877      s            (pplay(i,k).lt.60000.)) then
    2878                   ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*
    2879      s            (60000.-pplay(i,k))/(60000.-30000.)
    2880                else
    2881                   ratqss(i,k)=ratqshaut
    2882                endif
    2883             enddo
    2884          enddo
    2885 
    2886       else if (iflag_ratqs.eq.2) then
    2887 
    2888          do k=1,klev
    2889             do i=1, klon
    2890                if (pplay(i,k).ge.60000.) then
    2891                   ratqss(i,k)=ratqsbas
    2892      s            *(paprs(i,1)-pplay(i,k))/(paprs(i,1)-60000.)
    2893                else if ((pplay(i,k).ge.30000.).and.
    2894      s             (pplay(i,k).lt.60000.)) then
    2895                     ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*
    2896      s              (60000.-pplay(i,k))/(60000.-30000.)
    2897                else
    2898                     ratqss(i,k)=ratqshaut
    2899                endif
    2900             enddo
    2901          enddo
    2902 
    2903       else if (iflag_ratqs==3) then
    2904          do k=1,klev
    2905            ratqss(:,k)=ratqsbas+(ratqshaut-ratqsbas)
    2906      s     *min( ((paprs(:,1)-pplay(:,k))/70000.)**2 , 1. )
    2907          enddo
    2908 
    2909       else if (iflag_ratqs==4) then
    2910          do k=1,klev
    2911            ratqss(:,k)=ratqsbas+0.5*(ratqshaut-ratqsbas)
    2912      s     *( tanh( (50000.-pplay(:,k))/20000.) + 1.)
    2913          enddo
    2914 
    2915       endif
    2916 
    2917 
    2918 
    2919 
    2920 c  ratqs final
    2921 c  -----------
    2922 
    2923       if (iflag_cldcon.eq.1 .or.iflag_cldcon.eq.2
    2924      s    .or.iflag_cldcon.eq.4) then
    2925 
    2926 ! On ajoute une constante au ratqsc*2 pour tenir compte de
    2927 ! fluctuations turbulentes de petite echelle
    2928 
    2929          do k=1,klev
    2930             do i=1,klon
    2931                if ((fm_therm(i,k).gt.1.e-10)) then
    2932                   ratqsc(i,k)=sqrt(ratqsc(i,k)**2+0.05**2)
    2933                endif
    2934             enddo
    2935          enddo
    2936 
    2937 !   les ratqs sont une combinaison de ratqss et ratqsc
    2938        if(prt_level.ge.9)
    2939      $       write(lunout,*)'PHYLMD NOUVEAU TAU_RATQS ',tau_ratqs
    2940 
    2941          if (tau_ratqs>1.e-10) then
    2942             facteur=exp(-pdtphys/tau_ratqs)
    2943          else
    2944             facteur=0.
    2945          endif
    2946          ratqs(:,:)=ratqsc(:,:)*(1.-facteur)+ratqs(:,:)*facteur
    2947 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2948 ! FH 22/09/2009
    2949 ! La ligne ci-dessous faisait osciller le modele et donnait une solution
    2950 ! assymptotique bidon et dépendant fortement du pas de temps.
    2951 !        ratqs(:,:)=sqrt(ratqs(:,:)**2+ratqss(:,:)**2)
    2952 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2953          ratqs(:,:)=max(ratqs(:,:),ratqss(:,:))
    2954       else if (iflag_cldcon<=6) then
    2955 !   on ne prend que le ratqs stable pour fisrtilp
    2956          ratqs(:,:)=ratqss(:,:)
    2957       else
    2958           zfratqs1=exp(-pdtphys/10800.)
    2959           zfratqs2=exp(-pdtphys/10800.)
    2960 !         print*,'RAPPEL RATQS 1 ',zfratqs1,zfratqs2
    2961 !    s    ,ratqss(1,14),ratqs(1,14),ratqsc(1,14)
    2962           do k=1,klev
    2963              do i=1,klon
    2964                 if (ratqsc(i,k).gt.1.e-10) then
    2965                    ratqs(i,k)=ratqs(i,k)*zfratqs2
    2966      s             +(iflag_cldcon/100.)*ratqsc(i,k)*(1.-zfratqs2)
    2967                 endif
    2968                 ratqs(i,k)=min(ratqs(i,k)*zfratqs1
    2969      s          +ratqss(i,k)*(1.-zfratqs1),0.5)
    2970              enddo
    2971           enddo
    2972       endif
     2746! Computation of ratqs, the width (normalized) of the subrid scale
     2747! water distribution
     2748      CALL  calcratqs(klon,klev,prt_level,lunout,       
     2749     s     iflag_ratqs,iflag_con,iflag_cldcon,pdtphys,
     2750     s     ratqsbas,ratqshaut,tau_ratqs,fact_cldcon, 
     2751     s     ptconv,ptconvth,clwcon0th, rnebcon0th,   
     2752     s     paprs,pplay,q_seri,zqsat,fm_therm,
     2753     s     ratqs,ratqsc)
    29732754
    29742755
    … …  
    38433624     I     cdragh,   coefh,     fm_therm, entr_therm,
    38443625     I     u1,       v1,        ftsol,    pctsrf,
     3626     I     ustar,     u10m,      v10m,
    38453627     I     rlat,     frac_impa, frac_nucl,rlon,
    38463628     I     presnivs, pphis,     pphi,     albsol1,
    … …  
    39333715c
    39343716#include "calcul_STDlev.h"
    3935       twriteSTD(:,:,1)=tsumSTD(:,:,1)
    3936       qwriteSTD(:,:,1)=qsumSTD(:,:,1)
    3937       rhwriteSTD(:,:,1)=rhsumSTD(:,:,1)
    3938       phiwriteSTD(:,:,1)=phisumSTD(:,:,1)
    3939       uwriteSTD(:,:,1)=usumSTD(:,:,1)
    3940       vwriteSTD(:,:,1)=vsumSTD(:,:,1)
    3941       wwriteSTD(:,:,1)=wsumSTD(:,:,1)
    3942 
    3943       twriteSTD(:,:,2)=tsumSTD(:,:,2)
    3944       qwriteSTD(:,:,2)=qsumSTD(:,:,2)
    3945       rhwriteSTD(:,:,2)=rhsumSTD(:,:,2)
    3946       phiwriteSTD(:,:,2)=phisumSTD(:,:,2)
    3947       uwriteSTD(:,:,2)=usumSTD(:,:,2)
    3948       vwriteSTD(:,:,2)=vsumSTD(:,:,2)
    3949       wwriteSTD(:,:,2)=wsumSTD(:,:,2)
    3950 
    3951       twriteSTD(:,:,3)=tlevSTD(:,:)
    3952       qwriteSTD(:,:,3)=qlevSTD(:,:)
    3953       rhwriteSTD(:,:,3)=rhlevSTD(:,:)
    3954       phiwriteSTD(:,:,3)=philevSTD(:,:)
    3955       uwriteSTD(:,:,3)=ulevSTD(:,:)
    3956       vwriteSTD(:,:,3)=vlevSTD(:,:)
    3957       wwriteSTD(:,:,3)=wlevSTD(:,:)
    3958 
    3959       twriteSTD(:,:,4)=tlevSTD(:,:)
    3960       qwriteSTD(:,:,4)=qlevSTD(:,:)
    3961       rhwriteSTD(:,:,4)=rhlevSTD(:,:)
    3962       phiwriteSTD(:,:,4)=philevSTD(:,:)
    3963       uwriteSTD(:,:,4)=ulevSTD(:,:)
    3964       vwriteSTD(:,:,4)=vlevSTD(:,:)
    3965       wwriteSTD(:,:,4)=wlevSTD(:,:)
    3966 c
    3967 cIM initialisation 5eme fichier de sortie
    3968       twriteSTD(:,:,5)=tlevSTD(:,:)
    3969       qwriteSTD(:,:,5)=qlevSTD(:,:)
    3970       rhwriteSTD(:,:,5)=rhlevSTD(:,:)
    3971       phiwriteSTD(:,:,5)=philevSTD(:,:)
    3972       uwriteSTD(:,:,5)=ulevSTD(:,:)
    3973       vwriteSTD(:,:,5)=vlevSTD(:,:)
    3974       wwriteSTD(:,:,5)=wlevSTD(:,:)
    3975 c
    3976 cIM initialisation 6eme fichier de sortie
    3977       twriteSTD(:,:,6)=tlevSTD(:,:)
    3978       qwriteSTD(:,:,6)=qlevSTD(:,:)
    3979       rhwriteSTD(:,:,6)=rhlevSTD(:,:)
    3980       phiwriteSTD(:,:,6)=philevSTD(:,:)
    3981       uwriteSTD(:,:,6)=ulevSTD(:,:)
    3982       vwriteSTD(:,:,6)=vlevSTD(:,:)
    3983       wwriteSTD(:,:,6)=wlevSTD(:,:)
    3984 cIM for NMC files
    3985       DO n=1, nlevSTD3
    3986        DO k=1, nlevSTD
    3987         if(rlevSTD3(n).EQ.rlevSTD(k)) THEN
    3988          twriteSTD3(:,n)=tlevSTD(:,k)
    3989          qwriteSTD3(:,n)=qlevSTD(:,k)
    3990          rhwriteSTD3(:,n)=rhlevSTD(:,k)
    3991          phiwriteSTD3(:,n)=philevSTD(:,k)
    3992          uwriteSTD3(:,n)=ulevSTD(:,k)
    3993          vwriteSTD3(:,n)=vlevSTD(:,k)
    3994          wwriteSTD3(:,n)=wlevSTD(:,k)
    3995         endif !rlevSTD3(n).EQ.rlevSTD(k)
    3996        ENDDO
    3997       ENDDO
    3998 c
    3999       DO n=1, nlevSTD8
    4000        DO k=1, nlevSTD
    4001         if(rlevSTD8(n).EQ.rlevSTD(k)) THEN
    4002          tnondefSTD8(:,n)=tnondef(:,k,2)
    4003          twriteSTD8(:,n)=tsumSTD(:,k,2)
    4004          qwriteSTD8(:,n)=qsumSTD(:,k,2)
    4005          rhwriteSTD8(:,n)=rhsumSTD(:,k,2)
    4006          phiwriteSTD8(:,n)=phisumSTD(:,k,2)
    4007          uwriteSTD8(:,n)=usumSTD(:,k,2)
    4008          vwriteSTD8(:,n)=vsumSTD(:,k,2)
    4009          wwriteSTD8(:,n)=wsumSTD(:,k,2)
    4010         endif !rlevSTD8(n).EQ.rlevSTD(k)
    4011        ENDDO
    4012       ENDDO
    40133717c
    40143718c slp sea level pressure

  • LMDZ5/branches/testing/libf/phylmd/phytrac.F90

    r1665 r1707  
    88     cdragh,    coefh,    fm_therm, entr_therm,&
    99     yu1,       yv1,      ftsol,    pctsrf,    &
     10     ustar,     u10m,      v10m,               &
    1011     xlat,      frac_impa,frac_nucl,xlon,      &
    1112     presnivs,  pphis,    pphi,     albsol,    &
    … …  
    119120!--------------
    120121!
    121   REAL,DIMENSION(klon),INTENT(IN)      :: cdragh ! coeff drag pour T et Q
    122   REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh  ! coeff melange CL (m**2/s)
    123   REAL,DIMENSION(klon),INTENT(IN)      :: yu1    ! vents au premier niveau
    124   REAL,DIMENSION(klon),INTENT(IN)      :: yv1    ! vents au premier niveau
     122  REAL,DIMENSION(klon),INTENT(IN)     :: cdragh ! coeff drag pour T et Q
     123  REAL,DIMENSION(klon,klev),INTENT(IN):: coefh  ! coeff melange CL (m**2/s)
     124  REAL,DIMENSION(klon),INTENT(IN)     :: ustar,u10m,v10m ! u* & vent a 10m (m/s)
     125  REAL,DIMENSION(klon),INTENT(IN)     :: yu1    ! vents au premier niveau
     126  REAL,DIMENSION(klon),INTENT(IN)     :: yv1    ! vents au premier niveau
    125127!
    126128!Lessivage:
    … …  
    244246     !    -- Traitement des traceurs avec traclmdz
    245247     CALL traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, &
    246           cdragh,  coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon, couchelimite, &
    247           sh, tr_seri, source, solsym, d_tr_cl, zmasse)
     248          cdragh,  coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon,couchelimite,sh,&
     249          rh, pphi, ustar, u10m, v10m, &
     250          tr_seri, source, solsym, d_tr_cl, zmasse)
    248251  CASE('inca')
    249252     !    -- CHIMIE INCA  config_inca = aero or chem --

  • LMDZ5/branches/testing/libf/phylmd/printflag.F

    r1403 r1707  
    8787!        radpas0  = NINT( 86400./tabcntr0(1)/INT( tabcntr0(6) ) )
    8888        PRINT 100
    89         PRINT 22, radpas0, radpas
     89!        PRINT 22, radpas0, radpas
    9090        PRINT 100
    9191       ENDIF

  • LMDZ5/branches/testing/libf/phylmd/traclmdz_mod.F90

    r1665 r1707  
    279279  SUBROUTINE traclmdz(nstep, julien, gmtime, pdtphys, t_seri, paprs, pplay, &
    280280       cdragh,  coefh, yu1, yv1, ftsol, pctsrf, xlat, xlon, couchelimite, sh, &
     281       rh, pphi, ustar, zu10m, zv10m, &
    281282       tr_seri, source, solsym, d_tr_cl, zmasse)
    282283   
    … …  
    315316!--------------
    316317!
    317     REAL,DIMENSION(klon),INTENT(IN)      :: cdragh     ! coeff drag pour T et Q
    318     REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh      ! coeff melange CL (m**2/s)
    319     REAL,DIMENSION(klon),INTENT(IN)      :: yu1        ! vents au premier niveau
    320     REAL,DIMENSION(klon),INTENT(IN)      :: yv1        ! vents au premier niveau
     318    REAL,DIMENSION(klon),INTENT(IN)      :: cdragh  ! coeff drag pour T et Q
     319    REAL,DIMENSION(klon,klev),INTENT(IN) :: coefh   ! diffusivite turb (m**2/s)
     320    REAL,DIMENSION(klon),INTENT(IN)      :: yu1     ! vents au premier niveau
     321    REAL,DIMENSION(klon),INTENT(IN)      :: yv1     ! vents au premier niveau
    321322    LOGICAL,INTENT(IN)                   :: couchelimite
    322     REAL,DIMENSION(klon,klev),INTENT(IN) :: sh         ! humidite specifique
     323    REAL,DIMENSION(klon,klev),INTENT(IN) :: sh      ! humidite specifique
     324    REAL,DIMENSION(klon,klev),INTENT(IN) :: rh      ! Humidite relative
     325    REAL,DIMENSION(klon,klev),INTENT(IN) :: pphi    ! geopotentie
     326    REAL,DIMENSION(klon),INTENT(IN)      :: ustar   ! ustar (m/s)
     327    REAL,DIMENSION(klon),INTENT(IN)      :: zu10m   ! vent zonal 10m (m/s)
     328    REAL,DIMENSION(klon),INTENT(IN)      :: zv10m   ! vent zonal 10m (m/s)
    323329
    324330! Arguments necessaires pour les sources et puits de traceur:
Note: See TracChangeset for help on using the changeset viewer.