Changeset 1512


Ignore:
Timestamp:
Apr 29, 2011, 4:34:48 PM (14 years ago)
Author:
jghattas
Message:
  • Lecture pression 3D pour guidage niveaux modele (nouveau option guide_plevs=2)
  • calcul pression points u,v pour guidage sur niveaux modele(guide_plevs=1 ou =2)
  • option guide_model=TRUE remplace par guide_plevs=1, guide_model=FALSE remplace par guide_plevs=0


  • correction bug guide_read2D
  • correction bug guidage humidité (guide_Q)

Resultats sont identiques pour guide_plevs=0. Resultats modifie pour guide_plevs=1.
Remarque!! Version dyn3d/guide_mod.F90 n'a pas ete mise a jour.

Francis Codron

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/dyn3dpar/guide_p_mod.F90

    r1418 r1512  
    1919! ---------------------------------------------
    2020  INTEGER, PRIVATE, SAVE  :: iguide_read,iguide_int,iguide_sav
    21   INTEGER, PRIVATE, SAVE  :: nlevnc
     21  INTEGER, PRIVATE, SAVE  :: nlevnc, guide_plevs
    2222  LOGICAL, PRIVATE, SAVE  :: guide_u,guide_v,guide_T,guide_Q,guide_P
    2323  LOGICAL, PRIVATE, SAVE  :: guide_hr,guide_teta 
    2424  LOGICAL, PRIVATE, SAVE  :: guide_BL,guide_reg,guide_add,gamma4,guide_zon
    25   LOGICAL, PRIVATE, SAVE  :: guide_modele,invert_p,invert_y,ini_anal
    26   LOGICAL, PRIVATE, SAVE  :: guide_2D,guide_sav
     25  LOGICAL, PRIVATE, SAVE  :: invert_p,invert_y,ini_anal
     26  LOGICAL, PRIVATE, SAVE  :: guide_2D,guide_sav,guide_modele
    2727 
    2828  REAL, PRIVATE, SAVE     :: tau_min_u,tau_max_u
    … …  
    4848  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: tnat1,tnat2
    4949  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: qnat1,qnat2
     50  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: pnat1,pnat2
    5051  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: psnat1,psnat2
    5152  REAL, ALLOCATABLE, DIMENSION(:),     PRIVATE, SAVE   :: apnc,bpnc
    … …  
    6566
    6667  SUBROUTINE guide_init
    67 
     68   
    6869    USE control_mod
    6970    IMPLICIT NONE
    … …  
    127128! Parametres pour lecture des fichiers
    128129    CALL getpar('iguide_read',4,iguide_read,'freq. lecture guidage')
    129     CALL getpar('iguide_int',4,iguide_int,'freq. lecture guidage')
    130     IF (iguide_int.GT.0) THEN
     130    CALL getpar('iguide_int',4,iguide_int,'freq. interpolation vert')
     131    IF (iguide_int.EQ.0) THEN
     132        iguide_int=1
     133    ELSEIF (iguide_int.GT.0) THEN
    131134        iguide_int=day_step/iguide_int
    132135    ELSE
    133136        iguide_int=day_step*iguide_int
    134137    ENDIF
    135     CALL getpar('guide_modele',.false.,guide_modele,'guidage niveaux modele')
     138    CALL getpar('guide_plevs',0,guide_plevs,'niveaux pression fichiers guidage')
     139    ! Pour compatibilite avec ancienne version avec guide_modele
     140    CALL getpar('guide_modele',.false.,guide_modele,'niveaux pression ap+bp*psol')
     141    IF (guide_modele) THEN
     142        guide_plevs=1
     143    ENDIF
     144    ! Fin raccord
    136145    CALL getpar('ini_anal',.false.,ini_anal,'Etat initial = analyse')
    137146    CALL getpar('guide_invertp',.true.,invert_p,'niveaux p inverses')
    … …  
    144153! ---------------------------------------------
    145154    ncidpl=-99
    146     if (guide_modele) then
     155    if (guide_plevs.EQ.1) then
    147156       if (ncidpl.eq.-99) rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl)
    148     else
    149          if (guide_u) then
    150            if (ncidpl.eq.-99) rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
    151          elseif (guide_v) then
    152            if (ncidpl.eq.-99) rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
    153          elseif (guide_T) then
    154            if (ncidpl.eq.-99) rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
    155          elseif (guide_Q) then
    156            if (ncidpl.eq.-99) rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
    157          endif
     157    elseif (guide_plevs.EQ.2) then
     158       if (ncidpl.EQ.-99) rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl)
     159    elseif (guide_u) then
     160       if (ncidpl.eq.-99) rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
     161    elseif (guide_v) then
     162       if (ncidpl.eq.-99) rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
     163    elseif (guide_T) then
     164       if (ncidpl.eq.-99) rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
     165    elseif (guide_Q) then
     166       if (ncidpl.eq.-99) rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
    158167    endif
    159168    error=NF_INQ_DIMID(ncidpl,'LEVEL',rid)
    … …  
    240249    ENDIF
    241250
    242     IF (guide_P.OR.guide_modele) THEN
     251    IF (guide_plevs.EQ.2) THEN
     252        ALLOCATE(pnat1(iip1,jjp1,nlevnc), stat = error)
     253        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
     254        ALLOCATE(pnat2(iip1,jjp1,nlevnc), stat = error)
     255        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
     256        pnat1=0.;pnat2=0.;
     257    ENDIF
     258
     259    IF (guide_P.OR.guide_plevs.EQ.1) THEN
    243260        ALLOCATE(psnat1(iip1,jjp1), stat = error)
    244261        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
    … …  
    267284    IF (guide_T) tnat1=tnat2
    268285    IF (guide_Q) qnat1=qnat2
    269     IF (guide_P.OR.guide_modele) psnat1=psnat2
     286    IF (guide_plevs.EQ.2) pnat1=pnat2
     287    IF (guide_P.OR.guide_plevs.EQ.1) psnat1=psnat2
    270288
    271289  END SUBROUTINE guide_init
    … …  
    293311    LOGICAL       :: f_out ! sortie guidage
    294312    REAL, DIMENSION (ip1jmp1,llm) :: f_add ! var aux: champ de guidage
    295     REAL, DIMENSION (ip1jmp1,llm) :: p ! besoin si guide_P
     313    ! Variables pour fonction Exner (P milieu couche)
     314    REAL, DIMENSION (iip1,jjp1,llm)    :: pk, pkf
     315    REAL, DIMENSION (iip1,jjp1,llm)    :: alpha, beta
     316    REAL, DIMENSION (iip1,jjp1)        :: pks   
     317    REAL                               :: unskap
     318    REAL, DIMENSION (ip1jmp1,llmp1)    :: p ! besoin si guide_P
    296319    ! Compteurs temps:
    297320    INTEGER, SAVE :: step_rea,count_no_rea,itau_test ! lecture guidage
    … …  
    300323    REAL, SAVE    :: factt ! pas de temps en fraction de jour
    301324   
    302     INTEGER       :: l
     325    INTEGER       :: i,j,l
    303326   
    304327    ijb_u=ij_begin ; ije_u=ij_end ; ijn_u=ije_u-ijb_u+1 
    … …  
    313336    ENDIF
    314337     
    315    
    316    
    317338     PRINT *,'---> on rentre dans guide_main'
    318339!    CALL AllGather_Field(ucov,ip1jmp1,llm)
    … …  
    380401      dday_step=real(day_step)
    381402      IF (iguide_read.LT.0) THEN
    382           tau=ditau/dday_step/ REAL(iguide_read)
     403          tau=ditau/dday_step/REAL(iguide_read)
    383404      ELSE
    384           tau= REAL(iguide_read)*ditau/dday_step
     405          tau=REAL(iguide_read)*ditau/dday_step
    385406      ENDIF
    386407      reste=tau-AINT(tau)
    … …  
    394415              IF (guide_T) tnat1(:,jjb_u:jje_u,:)=tnat2(:,jjb_u:jje_u,:)
    395416              IF (guide_Q) qnat1(:,jjb_u:jje_u,:)=qnat2(:,jjb_u:jje_u,:)
    396               IF (guide_P.OR.guide_modele) psnat1(:,jjb_u:jje_u)=psnat2(:,jjb_u:jje_u)
     417              IF (guide_plevs.EQ.2) pnat1(:,jjb_u:jje_u,:)=pnat2(:,jjb_u:jje_u,:)
     418              IF (guide_P.OR.guide_plevs.EQ.1) psnat1(:,jjb_u:jje_u)=psnat2(:,jjb_u:jje_u)
    397419              step_rea=step_rea+1
    398420              itau_test=itau
    … …  
    430452! Sauvegarde du guidage?
    431453    f_out=((MOD(itau,iguide_sav).EQ.0).AND.guide_sav) 
    432     IF (f_out) CALL guide_out("S",jjp1,1,ps)
     454    IF (f_out) THEN
     455!       Calcul niveaux pression milieu de couches
     456        CALL pression_p( ip1jmp1, ap, bp, ps, p )
     457        CALL exner_hyb_p(ip1jmp1,ps,p,alpha,beta,pks,pk,pkf)
     458        unskap=1./kappa
     459        DO l = 1, llm
     460            DO j=jjb_u,jje_u
     461                DO i =1, iip1
     462                    p(i+(j-1)*iip1,l) = preff * ( pk(i,j,l)/cpp) ** unskap
     463                ENDDO
     464            ENDDO
     465        ENDDO
     466        CALL guide_out("P",jjp1,llm,p(1:ip1jmp1,1:llm),1.)
     467    ENDIF
    433468   
    434469    if (guide_u) then
    … …  
    441476        if (guide_zon) CALL guide_zonave(1,jjp1,llm,f_add)
    442477        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_u)
    443         IF (f_out) CALL guide_out("U",jjp1,llm,f_add/factt)
     478        IF (f_out) CALL guide_out("U",jjp1,llm,f_add(:,:),factt)
    444479        ucov(ijb_u:ije_u,:)=ucov(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:)
    445480    endif
    … …  
    453488        if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
    454489        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_T)
    455         IF (f_out) CALL guide_out("T",jjp1,llm,f_add/factt)
     490        IF (f_out) CALL guide_out("T",jjp1,llm,f_add(:,:),factt)
    456491        teta(ijb_u:ije_u,:)=teta(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:)
    457492    endif
    … …  
    465500        if (guide_zon) CALL guide_zonave(2,jjp1,1,f_add(1:ip1jmp1,1))
    466501        CALL guide_addfield(ip1jmp1,1,f_add(1:ip1jmp1,1),alpha_P)
    467         IF (f_out) CALL guide_out("P",jjp1,1,f_add(1:ip1jmp1,1)/factt)
     502        IF (f_out) CALL guide_out("SP",jjp1,1,f_add(1:ip1jmp1,1),factt)
    468503        ps(ijb_u:ije_u)=ps(ijb_u:ije_u)+f_add(ijb_u:ije_u,1)
    469504        CALL pression_p(ip1jmp1,ap,bp,ps,p)
    … …  
    479514        if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
    480515        CALL guide_addfield(ip1jmp1,llm,f_add,alpha_Q)
    481         IF (f_out) CALL guide_out("Q",jjp1,llm,f_add/factt)
     516        IF (f_out) CALL guide_out("Q",jjp1,llm,f_add(:,:),factt)
    482517        q(ijb_u:ije_u,:)=q(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:)
    483518    endif
    … …  
    492527        if (guide_zon) CALL guide_zonave(2,jjm,llm,f_add(1:ip1jm,:))
    493528        CALL guide_addfield(ip1jm,llm,f_add(1:ip1jm,:),alpha_v)
    494         IF (f_out) CALL guide_out("V",jjm,llm,f_add(1:ip1jm,:)/factt)
     529        IF (f_out) CALL guide_out("V",jjm,llm,f_add(1:ip1jm,:),factt)
    495530        vcov(ijb_v:ije_v,:)=vcov(ijb_v:ije_v,:)+f_add(ijb_v:ije_v,:)
    496531    endif
    … …  
    580615              ENDDO
    581616          ENDDO
    582           fieldm(:,l)=fieldm(:,l)/ REAL(imax(typ)-imin(typ)+1)
     617          fieldm(:,l)=fieldm(:,l)/REAL(imax(typ)-imin(typ)+1)
    583618    ! Compute forcing
    584619          DO j=jjb_v,jje_v
    … …  
    598633              ENDDO
    599634          ENDDO
    600           fieldm(:,l)=fieldm(:,l)/ REAL(imax(typ)-imin(typ)+1)
     635          fieldm(:,l)=fieldm(:,l)/REAL(imax(typ)-imin(typ)+1)
    601636    ! Compute forcing
    602637          DO j=jjb_u,jje_u
    … …  
    640675  REAL, DIMENSION (iip1,jjp1,llm)    :: alpha, beta
    641676  REAL, DIMENSION (iip1,jjp1)        :: pks   
    642   REAL                               :: prefkap,unskap
     677  REAL                               :: unskap
    643678  ! Pression de vapeur saturante
    644679  REAL, DIMENSION (ip1jmp1,llm)      :: qsat
    … …  
    652687    print *,'Guide: conversion variables guidage'
    653688! -----------------------------------------------------------------
    654 ! Calcul des niveaux de pression champs guidage
     689! Calcul des niveaux de pression champs guidage (pour T et Q)
    655690! -----------------------------------------------------------------
    656 if (guide_modele) then
    657     do i=1,iip1
    658         do j=jjb_u,jje_u
    659             do l=1,nlevnc
    660                 plnc2(i,j,l)=apnc(l)+bpnc(l)*psnat2(i,j)
    661                 plnc1(i,j,l)=apnc(l)+bpnc(l)*psnat1(i,j)
    662             enddo
    663         enddo
    664     enddo
    665 else
    666     do i=1,iip1
    667         do j=jjb_u,jje_u
    668             do l=1,nlevnc
    669                 plnc2(i,j,l)=apnc(l)
    670                 plnc1(i,j,l)=apnc(l)
    671            enddo
    672         enddo
    673     enddo
    674 
    675 endif
     691    IF (guide_plevs.EQ.0) THEN
     692        DO l=1,nlevnc
     693            DO j=jjb_u,jje_u
     694                DO i=1,iip1
     695                    plnc2(i,j,l)=apnc(l)
     696                    plnc1(i,j,l)=apnc(l)
     697               ENDDO
     698            ENDDO
     699        ENDDO
     700    ENDIF   
     701
    676702    if (first) then
    677703        first=.FALSE.
    … …  
    683709        enddo
    684710        print*,'Fichiers guidage'
    685         do l=1,nlevnc
    686              print*,'PL(',l,')=',plnc2(1,jjb_u,l)
    687         enddo
     711        SELECT CASE (guide_plevs)
     712        CASE (0)
     713            do l=1,nlevnc
     714                 print*,'PL(',l,')=',plnc2(1,jjb_u,l)
     715            enddo
     716        CASE (1)
     717            DO l=1,nlevnc
     718                 print*,'PL(',l,')=',apnc(l)+bpnc(l)*psnat2(i,jjb_u)
     719             ENDDO
     720        CASE (2)
     721            do l=1,nlevnc
     722                 print*,'PL(',l,')=',pnat2(1,jjb_u,l)
     723            enddo
     724        END SELECT
    688725        print *,'inversion de l''ordre: invert_p=',invert_p
    689726        if (guide_u) then
    … …  
    702739! Calcul niveaux pression modele
    703740! -----------------------------------------------------------------
    704     CALL pression_p( ip1jmp1, ap, bp, psi, p )
    705     CALL exner_hyb_p(ip1jmp1,psi,p,alpha,beta,pks,pk,pkf)
    706741
    707742!    ....  Calcul de pls , pression au milieu des couches ,en Pascals
    708     unskap=1./kappa
    709     prefkap =  preff  ** kappa
    710     DO l = 1, llm
    711         DO j=jjb_u,jje_u
    712             DO i =1, iip1
    713                 pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
    714             ENDDO
     743    IF (guide_plevs.EQ.1) THEN
     744        DO l=1,llm
     745            DO j=jjb_u,jje_u
     746                DO i =1, iip1
     747                    pls(i,j,l)=(ap(l)+ap(l+1))/2.+psi(i,j)*(bp(l)+bp(l+1))/2.
     748                ENDDO
     749            ENDDO
    715750        ENDDO
    716     ENDDO
     751    ELSE
     752        CALL pression_p( ip1jmp1, ap, bp, psi, p )
     753        CALL exner_hyb_p(ip1jmp1,psi,p,alpha,beta,pks,pk,pkf)
     754        unskap=1./kappa
     755        DO l = 1, llm
     756            DO j=jjb_u,jje_u
     757                DO i =1, iip1
     758                    pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
     759                ENDDO
     760            ENDDO
     761        ENDDO
     762    ENDIF
    717763
    718764!   calcul des pressions pour les grilles u et v
    … …  
    747793
    748794! -----------------------------------------------------------------
    749 ! Interpolation champs guidage sur niveaux modele (+inversion N/S)
     795! Interpolation verticale champs guidage sur niveaux modele
    750796! Conversion en variables gcm (ucov, vcov...)
    751797! -----------------------------------------------------------------
    … …  
    762808    endif
    763809
     810    IF (guide_T) THEN
     811        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
     812        IF (guide_plevs.EQ.1) THEN
     813            DO l=1,nlevnc
     814                DO j=jjb_u,jje_u
     815                    DO i=1,iip1
     816                        plnc2(i,j,l)=apnc(l)+bpnc(l)*psnat2(i,j)
     817                        plnc1(i,j,l)=apnc(l)+bpnc(l)*psnat1(i,j)
     818                    ENDDO
     819                ENDDO
     820            ENDDO
     821        ELSE IF (guide_plevs.EQ.2) THEN
     822            DO l=1,nlevnc
     823                DO j=jjb_u,jje_u
     824                    DO i=1,iip1
     825                        plnc2(i,j,l)=pnat2(i,j,l)
     826                        plnc1(i,j,l)=pnat1(i,j,l)
     827                    ENDDO
     828                ENDDO
     829            ENDDO
     830        ENDIF
     831
     832        ! Interpolation verticale
     833        CALL pres2lev(tnat1(:,jjb_u:jje_u,:),zu1(:,jjb_u:jje_u,:),nlevnc,llm,           &
     834                    plnc1(:,jjb_u:jje_u,:),plsnc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
     835        CALL pres2lev(tnat2(:,jjb_u:jje_u,:),zu2(:,jjb_u:jje_u,:),nlevnc,llm,           &
     836                    plnc2(:,jjb_u:jje_u,:),plsnc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
     837
     838        ! Conversion en variables GCM
     839        do l=1,llm
     840            do j=jjb_u,jje_u
     841                IF (guide_teta) THEN
     842                    do i=1,iim
     843                        ij=(j-1)*iip1+i
     844                        tgui1(ij,l)=zu1(i,j,l)
     845                        tgui2(ij,l)=zu2(i,j,l)
     846                    enddo
     847                ELSE
     848                    do i=1,iim
     849                        ij=(j-1)*iip1+i
     850                        tgui1(ij,l)=zu1(i,j,l)*cpp/pk(i,j,l)
     851                        tgui2(ij,l)=zu2(i,j,l)*cpp/pk(i,j,l)
     852                    enddo
     853                ENDIF
     854                tgui1(j*iip1,l)=tgui1((j-1)*iip1+1,l)   
     855                tgui2(j*iip1,l)=tgui2((j-1)*iip1+1,l)   
     856            enddo
     857            do i=1,iip1
     858                tgui1(i,l)=tgui1(1,l)
     859                tgui1(ip1jm+i,l)=tgui1(ip1jm+1,l)
     860                tgui2(i,l)=tgui2(1,l)
     861                tgui2(ip1jm+i,l)=tgui2(ip1jm+1,l)
     862            enddo
     863        enddo
     864    ENDIF
     865
     866    IF (guide_Q) THEN
     867        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
     868        IF (guide_plevs.EQ.1) THEN
     869            DO l=1,nlevnc
     870                DO j=jjb_u,jje_u
     871                    DO i=1,iip1
     872                        plnc2(i,j,l)=apnc(l)+bpnc(l)*psnat2(i,j)
     873                        plnc1(i,j,l)=apnc(l)+bpnc(l)*psnat1(i,j)
     874                    ENDDO
     875                ENDDO
     876            ENDDO
     877        ELSE IF (guide_plevs.EQ.2) THEN
     878            DO l=1,nlevnc
     879                DO j=jjb_u,jje_u
     880                    DO i=1,iip1
     881                        plnc2(i,j,l)=pnat2(i,j,l)
     882                        plnc1(i,j,l)=pnat1(i,j,l)
     883                    ENDDO
     884                ENDDO
     885            ENDDO
     886        ENDIF
     887
     888        ! Interpolation verticale
     889        CALL pres2lev(qnat1(:,jjb_u:jje_u,:),zu1(:,jjb_u:jje_u,:),nlevnc,llm,             &
     890                      plnc1(:,jjb_u:jje_u,:),plsnc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
     891        CALL pres2lev(qnat2(:,jjb_u:jje_u,:),zu2(:,jjb_u:jje_u,:),nlevnc,llm,             &
     892                      plnc2(:,jjb_u:jje_u,:),plsnc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
     893
     894        ! Conversion en variables GCM
     895        ! On suppose qu'on a la bonne variable dans le fichier de guidage:
     896        ! Hum.Rel si guide_hr, Hum.Spec. sinon.
     897        do l=1,llm
     898            do j=jjb_u,jje_u
     899                do i=1,iim
     900                    ij=(j-1)*iip1+i
     901                    qgui1(ij,l)=zu1(i,j,l)
     902                    qgui2(ij,l)=zu2(i,j,l)
     903                enddo
     904                qgui1(j*iip1,l)=qgui1((j-1)*iip1+1,l)   
     905                qgui2(j*iip1,l)=qgui2((j-1)*iip1+1,l)   
     906            enddo
     907            do i=1,iip1
     908                qgui1(i,l)=qgui1(1,l)
     909                qgui1(ip1jm+i,l)=qgui1(ip1jm+1,l)
     910                qgui2(i,l)=qgui2(1,l)
     911                qgui2(ip1jm+i,l)=qgui2(ip1jm+1,l)
     912            enddo
     913        enddo
     914        IF (guide_hr) THEN
     915            CALL q_sat(iip1*jjn_u*llm,teta(:,jjb_u:jje_u,:)*pk(:,jjb_u:jje_u,:)/cpp,       &
     916                       plsnc(:,jjb_u:jje_u,:),qsat(ijb_u:ije_u,:))
     917            qgui1(ijb_u:ije_u,:)=qgui1(ijb_u:ije_u,:)*qsat(ijb_u:ije_u,:)*0.01 !hum. rel. en %
     918            qgui2(ijb_u:ije_u,:)=qgui2(ijb_u:ije_u,:)*qsat(ijb_u:ije_u,:)*0.01
     919        ENDIF
     920    ENDIF
     921
    764922    IF (guide_u) THEN
     923        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
     924        IF (guide_plevs.EQ.1) THEN
     925            DO l=1,nlevnc
     926                DO j=jjb_u,jje_u
     927                    DO i=1,iim
     928                        plnc2(i,j,l)=apnc(l)+bpnc(l)*(psnat2(i,j)*aire(i,j)*alpha1p2(i,j) &
     929                       &           +psnat2(i+1,j)*aire(i+1,j)*alpha3p4(i+1,j))/aireu(i,j)
     930                        plnc1(i,j,l)=apnc(l)+bpnc(l)*(psnat1(i,j)*aire(i,j)*alpha1p2(i,j) &
     931                       &           +psnat1(i+1,j)*aire(i+1,j)*alpha3p4(i+1,j))/aireu(i,j)
     932                    ENDDO
     933                    plnc2(iip1,j,l)=plnc2(1,j,l)
     934                    plnc1(iip1,j,l)=plnc1(1,j,l)
     935                ENDDO
     936            ENDDO
     937        ELSE IF (guide_plevs.EQ.2) THEN
     938            DO l=1,nlevnc
     939                DO j=jjb_u,jje_u
     940                    DO i=1,iim
     941                        plnc2(i,j,l)=(pnat2(i,j,l)*aire(i,j)*alpha1p2(i,j) &
     942                       & +pnat2(i+1,j,l)*aire(i,j)*alpha3p4(i+1,j))/aireu(i,j)
     943                        plnc1(i,j,l)=(pnat1(i,j,l)*aire(i,j)*alpha1p2(i,j) &
     944                       & +pnat1(i+1,j,l)*aire(i,j)*alpha3p4(i+1,j))/aireu(i,j)
     945                    ENDDO
     946                    plnc2(iip1,j,l)=plnc2(1,j,l)
     947                    plnc1(iip1,j,l)=plnc1(1,j,l)
     948                ENDDO
     949            ENDDO
     950        ENDIF
     951       
     952        ! Interpolation verticale
    765953        CALL pres2lev(unat1(:,jjb_u:jje_u,:),zu1(:,jjb_u:jje_u,:),nlevnc,llm,            &
    766954                      plnc1(:,jjb_u:jje_u,:),plunc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
    … …  
    768956                      plnc2(:,jjb_u:jje_u,:),plunc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
    769957
     958        ! Conversion en variables GCM
    770959        do l=1,llm
    771960            do j=jjb_u,jje_u
    … …  
    787976    ENDIF
    788977   
    789     IF (guide_T) THEN
    790         CALL pres2lev(tnat1(:,jjb_u:jje_u,:),zu1(:,jjb_u:jje_u,:),nlevnc,llm,           &
    791                       plnc1(:,jjb_u:jje_u,:),plsnc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
    792         CALL pres2lev(tnat2(:,jjb_u:jje_u,:),zu2(:,jjb_u:jje_u,:),nlevnc,llm,           &
    793                       plnc2(:,jjb_u:jje_u,:),plsnc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
    794 
    795         do l=1,llm
    796             do j=jjb_u,jje_u
    797                 IF (guide_teta) THEN
    798                     do i=1,iim
    799                         ij=(j-1)*iip1+i
    800                         tgui1(ij,l)=zu1(i,j,l)
    801                         tgui2(ij,l)=zu2(i,j,l)
    802                     enddo
    803                 ELSE
    804                     do i=1,iim
    805                         ij=(j-1)*iip1+i
    806                         tgui1(ij,l)=zu1(i,j,l)*cpp/pk(i,j,l)
    807                         tgui2(ij,l)=zu2(i,j,l)*cpp/pk(i,j,l)
    808                     enddo
    809                 ENDIF
    810                 tgui1(j*iip1,l)=tgui1((j-1)*iip1+1,l)   
    811                 tgui2(j*iip1,l)=tgui2((j-1)*iip1+1,l)   
    812             enddo
    813             do i=1,iip1
    814                 tgui1(i,l)=tgui1(1,l)
    815                 tgui1(ip1jm+i,l)=tgui1(ip1jm+1,l)
    816                 tgui2(i,l)=tgui2(1,l)
    817                 tgui2(ip1jm+i,l)=tgui2(ip1jm+1,l)
    818             enddo
    819         enddo
    820     ENDIF
    821 
    822978    IF (guide_v) THEN
    823        
     979        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
     980        IF (guide_plevs.EQ.1) THEN
     981         CALL Register_SwapFieldHallo(psnat1,psnat1,ip1jmp1,1,jj_Nb_caldyn,1,2,Req)
     982         CALL SendRequest(Req)
     983         CALL WaitRequest(Req)
     984         CALL Register_SwapFieldHallo(psnat2,psnat2,ip1jmp1,1,jj_Nb_caldyn,1,2,Req)
     985         CALL SendRequest(Req)
     986         CALL WaitRequest(Req)
     987            DO l=1,nlevnc
     988                DO j=jjb_v,jje_v
     989                    DO i=1,iip1
     990                        plnc2(i,j,l)=apnc(l)+bpnc(l)*(psnat2(i,j)*aire(i,j)*alpha2p3(i,j) &
     991                       &           +psnat2(i,j+1)*aire(i,j+1)*alpha1p4(i,j+1))/airev(i,j)
     992                        plnc1(i,j,l)=apnc(l)+bpnc(l)*(psnat1(i,j)*aire(i,j)*alpha2p3(i,j) &
     993                       &           +psnat1(i,j+1)*aire(i,j+1)*alpha1p4(i,j+1))/airev(i,j)
     994                    ENDDO
     995                ENDDO
     996            ENDDO
     997        ELSE IF (guide_plevs.EQ.2) THEN
     998         CALL Register_SwapFieldHallo(pnat1,pnat1,ip1jmp1,llm,jj_Nb_caldyn,1,2,Req)
     999         CALL SendRequest(Req)
     1000         CALL WaitRequest(Req)
     1001         CALL Register_SwapFieldHallo(pnat2,pnat2,ip1jmp1,llm,jj_Nb_caldyn,1,2,Req)
     1002         CALL SendRequest(Req)
     1003         CALL WaitRequest(Req)
     1004            DO l=1,nlevnc
     1005                DO j=jjb_v,jje_v
     1006                    DO i=1,iip1
     1007                        plnc2(i,j,l)=(pnat2(i,j,l)*aire(i,j)*alpha2p3(i,j) &
     1008                       & +pnat2(i,j+1,l)*aire(i,j)*alpha1p4(i,j+1))/airev(i,j)
     1009                        plnc1(i,j,l)=(pnat1(i,j,l)*aire(i,j)*alpha2p3(i,j) &
     1010                       & +pnat1(i,j+1,l)*aire(i,j)*alpha1p4(i,j+1))/airev(i,j)
     1011                    ENDDO
     1012                ENDDO
     1013            ENDDO
     1014        ENDIF
     1015        ! Interpolation verticale
    8241016        CALL pres2lev(vnat1(:,jjb_v:jje_v,:),zv1(:,jjb_v:jje_v,:),nlevnc,llm,             &
    8251017                      plnc1(:,jjb_v:jje_v,:),plvnc(:,jjb_v:jje_v,:),iip1,jjn_v,invert_p)
    8261018        CALL pres2lev(vnat2(:,jjb_v:jje_v,:),zv2(:,jjb_v:jje_v,:),nlevnc,llm,             &
    8271019                      plnc2(:,jjb_v:jje_v,:),plvnc(:,jjb_v:jje_v,:),iip1,jjn_v,invert_p)
    828 
     1020        ! Conversion en variables GCM
    8291021        do l=1,llm
    8301022            do j=jjb_v,jje_v
    … …  
    8401032    ENDIF
    8411033   
    842     IF (guide_Q) THEN
    843         ! On suppose qu'on a la bonne variable dans le fichier de guidage:
    844         ! Hum.Rel si guide_hr, Hum.Spec. sinon.
    845         CALL pres2lev(qnat1(:,jjb_u:jje_u,:),zu1(:,jjb_u:jje_u,:),nlevnc,llm,             &
    846                       plnc1(:,jjb_u:jje_u,:),plsnc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
    847         CALL pres2lev(qnat2(:,jjb_u:jje_u,:),zu2(:,jjb_u:jje_u,:),nlevnc,llm,             &
    848                       plnc2(:,jjb_u:jje_u,:),plsnc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
    849 
    850         do l=1,llm
    851             do j=jjb_u,jjb_v
    852                 do i=1,iim
    853                     ij=(j-1)*iip1+i
    854                     qgui1(ij,l)=zu1(i,j,l)
    855                     qgui2(ij,l)=zu2(i,j,l)
    856                 enddo
    857                 qgui1(j*iip1,l)=qgui1((j-1)*iip1+1,l)   
    858                 qgui2(j*iip1,l)=qgui2((j-1)*iip1+1,l)   
    859             enddo
    860             do i=1,iip1
    861                 qgui1(i,l)=qgui1(1,l)
    862                 qgui1(ip1jm+i,l)=qgui1(ip1jm+1,l)
    863                 qgui2(i,l)=qgui2(1,l)
    864                 qgui2(ip1jm+i,l)=qgui2(ip1jm+1,l)
    865             enddo
    866         enddo
    867         IF (guide_hr) THEN
    868             CALL q_sat(iip1*jjn_u*llm,teta(:,jjb_u:jje_u,:)*pk(:,jjb_u:jje_u,:)/cpp,       &
    869                        plsnc(:,jjb_u:jje_u,:),qsat(ijb_u:ije_u,:))
    870             qgui1(ijb_u:ije_u,:)=qgui1(ijb_u:ije_u,:)*qsat(ijb_u:ije_u,:)*0.01 !hum. rel. en %
    871             qgui2(ijb_u:ije_u,:)=qgui2(ijb_u:ije_u,:)*qsat(ijb_u:ije_u,:)*0.01
    872         ENDIF
    873     ENDIF
    8741034
    8751035  END SUBROUTINE guide_interp
    … …  
    10551215    LOGICAL, SAVE         :: first=.TRUE.
    10561216! Identification fichiers et variables NetCDF:
    1057     INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidQ
    1058     INTEGER, SAVE         :: varidQ,ncidt,varidt,ncidps,varidps
     1217    INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidp,varidp
     1218    INTEGER, SAVE         :: ncidQ,varidQ,ncidt,varidt,ncidps,varidps
    10591219    INTEGER               :: ncidpl,varidpl,varidap,varidbp
    10601220! Variables auxiliaires NetCDF:
    … …  
    10681228         ncidpl=-99
    10691229         print*,'Guide: ouverture des fichiers guidage '
    1070 ! Niveaux de pression si non constants
    1071          if (guide_modele) then
    1072              print *,'Lecture du guidage sur niveaux mod�le'
     1230! Ap et Bp si Niveaux de pression hybrides
     1231         if (guide_plevs.EQ.1) then
     1232             print *,'Lecture du guidage sur niveaux modele'
    10731233             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    10741234             rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
    10751235             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    10761236             print*,'ncidpl,varidap',ncidpl,varidap
     1237         endif
     1238! Pression si guidage sur niveaux P variables
     1239         if (guide_plevs.EQ.2) then
     1240             rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
     1241             rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
     1242             print*,'ncidp,varidp',ncidp,varidp
     1243             if (ncidpl.eq.-99) ncidpl=ncidp
    10771244         endif
    10781245! Vent zonal
    … …  
    11051272         endif
    11061273! Pression de surface
    1107          if ((guide_P).OR.(guide_modele)) then
     1274         if ((guide_P).OR.(guide_plevs.EQ.1)) then
    11081275             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    11091276             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    … …  
    11111278         endif
    11121279! Coordonnee verticale
    1113          if (.not.guide_modele) then
     1280         if (guide_plevs.EQ.0) then
    11141281              rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    11151282              IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    … …  
    11171284         endif
    11181285! Coefs ap, bp pour calcul de la pression aux differents niveaux
    1119          if (guide_modele) then
     1286         IF (guide_plevs.EQ.1) THEN
    11201287#ifdef NC_DOUBLE
    11211288             status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc)
    … …  
    11251292             status=NF_GET_VARA_REAL(ncidpl,varidbp,1,nlevnc,bpnc)
    11261293#endif
    1127          else
     1294         ELSEIF (guide_plevs.EQ.0) THEN
    11281295#ifdef NC_DOUBLE
    11291296             status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc)
    … …  
    11331300             apnc=apnc*100.! conversion en Pascals
    11341301             bpnc(:)=0.
    1135          endif
     1302         ENDIF
    11361303         first=.FALSE.
    1137      endif ! (first)
     1304     ENDIF ! (first)
    11381305
    11391306! -----------------------------------------------------------------
    … …  
    11521319     count(4)=1
    11531320
     1321! Pression
     1322     if (guide_plevs.EQ.2) then
     1323#ifdef NC_DOUBLE
     1324         status=NF_GET_VARA_DOUBLE(ncidp,varidp,start,count,pnat2)
     1325#else
     1326         status=NF_GET_VARA_REAL(ncidp,varidp,start,count,pnat2)
     1327#endif
     1328         IF (invert_y) THEN
     1329           CALL invert_lat(iip1,jjp1,nlevnc,pnat2)
     1330         ENDIF
     1331     endif
     1332
    11541333!  Vent zonal
    11551334     if (guide_u) then
    … …  
    12041383
    12051384!  Pression de surface
    1206      if ((guide_P).OR.(guide_modele))  then
     1385     if ((guide_P).OR.(guide_plevs.EQ.1))  then
    12071386         start(3)=timestep
    12081387         start(4)=0
    … …  
    12351414    LOGICAL, SAVE         :: first=.TRUE.
    12361415! Identification fichiers et variables NetCDF:
    1237     INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidQ
    1238     INTEGER, SAVE         :: varidQ,ncidt,varidt,ncidps,varidps
     1416    INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidp,varidp
     1417    INTEGER, SAVE         :: ncidQ,varidQ,ncidt,varidt,ncidps,varidps
    12391418    INTEGER               :: ncidpl,varidpl,varidap,varidbp
    12401419! Variables auxiliaires NetCDF:
    … …  
    12521431         ncidpl=-99
    12531432         print*,'Guide: ouverture des fichiers guidage '
    1254 ! Niveaux de pression si non constants
    1255          if (guide_modele) then
     1433! Ap et Bp si niveaux de pression hybrides
     1434         if (guide_plevs.EQ.1) then
    12561435             print *,'Lecture du guidage sur niveaux mod�le'
    12571436             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    … …  
    12591438             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    12601439             print*,'ncidpl,varidap',ncidpl,varidap
     1440         endif
     1441! Pression
     1442         if (guide_plevs.EQ.2) then
     1443             rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
     1444             rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
     1445             print*,'ncidp,varidp',ncidp,varidp
     1446             if (ncidpl.eq.-99) ncidpl=ncidp
    12611447         endif
    12621448! Vent zonal
    … …  
    12891475         endif
    12901476! Pression de surface
    1291          if ((guide_P).OR.(guide_modele)) then
     1477         if ((guide_P).OR.(guide_plevs.EQ.1)) then
    12921478             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    12931479             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    … …  
    12951481         endif
    12961482! Coordonnee verticale
    1297          if (.not.guide_modele) then
     1483         if (guide_plevs.EQ.0) then
    12981484              rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    12991485              IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    … …  
    13011487         endif
    13021488! Coefs ap, bp pour calcul de la pression aux differents niveaux
    1303          if (guide_modele) then
     1489         if (guide_plevs.EQ.1) then
    13041490#ifdef NC_DOUBLE
    13051491             status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc)
    … …  
    13091495             status=NF_GET_VARA_REAL(ncidpl,varidbp,1,nlevnc,bpnc)
    13101496#endif
    1311          else
     1497         elseif (guide_plevs.EQ.0) THEN
    13121498#ifdef NC_DOUBLE
    13131499             status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc)
    … …  
    13361522     count(4)=1
    13371523
     1524!  Pression
     1525     if (guide_plevs.EQ.2) then
     1526#ifdef NC_DOUBLE
     1527         status=NF_GET_VARA_DOUBLE(ncidp,varidp,start,count,zu)
     1528#else
     1529         status=NF_GET_VARA_REAL(ncidp,varidp,start,count,zu)
     1530#endif
     1531         DO i=1,iip1
     1532             pnat2(i,:,:)=zu(:,:)
     1533         ENDDO
     1534
     1535         IF (invert_y) THEN
     1536           CALL invert_lat(iip1,jjp1,nlevnc,pnat2)
     1537         ENDIF
     1538     endif
    13381539!  Vent zonal
    13391540     if (guide_u) then
    … …  
    13501551           CALL invert_lat(iip1,jjp1,nlevnc,unat2)
    13511552         ENDIF
    1352 
    13531553     endif
    13541554
    … …  
    13671567           CALL invert_lat(iip1,jjp1,nlevnc,tnat2)
    13681568         ENDIF
    1369 
    13701569     endif
    13711570
    … …  
    13841583           CALL invert_lat(iip1,jjp1,nlevnc,qnat2)
    13851584         ENDIF
    1386 
    13871585     endif
    13881586
    … …  
    14021600           CALL invert_lat(iip1,jjm,nlevnc,vnat2)
    14031601         ENDIF
    1404 
    14051602     endif
    14061603
    14071604!  Pression de surface
    1408      if ((guide_P).OR.(guide_modele))  then
     1605     if ((guide_P).OR.(guide_plevs.EQ.1))  then
    14091606         start(3)=timestep
    14101607         start(4)=0
    … …  
    14241621           CALL invert_lat(iip1,jjp1,1,psnat2)
    14251622         ENDIF
    1426 
    14271623     endif
    14281624
    … …  
    14301626 
    14311627!=======================================================================
    1432   SUBROUTINE guide_out(varname,hsize,vsize,field)
     1628  SUBROUTINE guide_out(varname,hsize,vsize,field,factt)
    14331629    USE parallel
    14341630    IMPLICIT NONE
    … …  
    14451641    INTEGER,   INTENT (IN)                         :: hsize,vsize
    14461642    REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field
     1643    REAL, INTENT (IN)                              :: factt
    14471644
    14481645    ! Variables locales
    … …  
    15071704! --------------------------------------------------------------------
    15081705        ierr = NF_REDEF(nid)
    1509 ! Surface pressure (GCM)
    1510         dim3=(/id_lonv,id_latu,id_tim/)
    1511         ierr = NF_DEF_VAR(nid,"SP",NF_FLOAT,3,dim3,varid)
     1706! Pressure (GCM)
     1707        dim4=(/id_lonv,id_latu,id_lev,id_tim/)
     1708        ierr = NF_DEF_VAR(nid,"P",NF_FLOAT,4,dim4,varid)
    15121709! Surface pressure (guidage)
    15131710        IF (guide_P) THEN
    … …  
    15431740! Enregistrement du champ
    15441741! --------------------------------------------------------------------
     1742 
    15451743    ierr=NF_OPEN("guide_ins.nc",NF_WRITE,nid)
    15461744
    15471745    SELECT CASE (varname)
    1548     CASE ("S")
     1746    CASE ("P")
    15491747        timestep=timestep+1
    1550         ierr = NF_INQ_VARID(nid,"SP",varid)
    1551         start=(/1,1,timestep,0/)
    1552         count=(/iip1,jjp1,1,0/)
     1748        ierr = NF_INQ_VARID(nid,"P",varid)
     1749        start=(/1,1,1,timestep/)
     1750        count=(/iip1,jjp1,llm,1/)
    15531751#ifdef NC_DOUBLE
    15541752        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    … …  
    15561754        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
    15571755#endif
    1558     CASE ("P")
     1756    CASE ("SP")
    15591757        ierr = NF_INQ_VARID(nid,"ps",varid)
    15601758        start=(/1,1,timestep,0/)
    15611759        count=(/iip1,jjp1,1,0/)
    15621760#ifdef NC_DOUBLE
    1563         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1564 #else
    1565         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
     1761        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
     1762#else
     1763        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    15661764#endif
    15671765    CASE ("U")
    … …  
    15701768        count=(/iip1,jjp1,llm,1/)
    15711769#ifdef NC_DOUBLE
    1572         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1573 #else
    1574         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
     1770        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
     1771#else
     1772        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    15751773#endif
    15761774    CASE ("V")
    … …  
    15791777        count=(/iip1,jjm,llm,1/)
    15801778#ifdef NC_DOUBLE
    1581         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1582 #else
    1583         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
     1779        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
     1780#else
     1781        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    15841782#endif
    15851783    CASE ("T")
    … …  
    15881786        count=(/iip1,jjp1,llm,1/)
    15891787#ifdef NC_DOUBLE
    1590         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1591 #else
    1592         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
     1788        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
     1789#else
     1790        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    15931791#endif
    15941792    CASE ("Q")
    … …  
    15971795        count=(/iip1,jjp1,llm,1/)
    15981796#ifdef NC_DOUBLE
    1599         ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field)
    1600 #else
    1601         ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field)
     1797        ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field/factt)
     1798#else
     1799        ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field/factt)
    16021800#endif
    16031801    END SELECT
Note: See TracChangeset for help on using the changeset viewer.