Ignore:
Timestamp:
Nov 19, 2021, 4:58:59 PM (4 years ago)
Author:
lguez
Message:

Sync latest trunk changes to Ocean_skin

Location:
LMDZ6/branches/Ocean_skin
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Ocean_skin

  • LMDZ6/branches/Ocean_skin/libf/dyn3d/conf_gcm.F90

    r3605 r4013  
    595595     !Config         'inca' = model de chime INCA
    596596     !Config         'repr' = model de chime REPROBUS
     597     !Config         'inco' = INCA + CO2i (temporaire)
    597598     type_trac = 'lmdz'
    598599     CALL getin('type_trac',type_trac)
    … …  
    790791     !Config         'inca' = model de chime INCA
    791792     !Config         'repr' = model de chime REPROBUS
     793     !Config         'inco' = INCA + CO2i (temporaire)
    792794     type_trac = 'lmdz'
    793795     CALL getin('type_trac',type_trac)

  • LMDZ6/branches/Ocean_skin/libf/dyn3d/dynredem.F90

    r3811 r4013  
    227227!--- Tracers in file "start_trac.nc" (added by Anne)
    228228  lread_inca=.FALSE.; fil="start_trac.nc"
    229   IF(type_trac=='inca') INQUIRE(FILE=fil,EXIST=lread_inca)
     229  IF(type_trac=='inca' .OR. type_trac=='inco') INQUIRE(FILE=fil,EXIST=lread_inca)
    230230  IF(lread_inca) CALL err(NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open")
    231231

  • LMDZ6/branches/Ocean_skin/libf/dyn3d/guide_mod.F90

    r3811 r4013  
    99!=======================================================================
    1010
    11   USE getparam
     11  USE getparam, only: ini_getparam, fin_getparam, getpar
    1212  USE Write_Field
    13   use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close
    14   use pres2lev_mod
     13  use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
     14                    nf90_inq_dimid, nf90_inquire_dimension
     15  use pres2lev_mod, only: pres2lev
    1516
    1617  IMPLICIT NONE
    … …  
    2021! ---------------------------------------------
    2122  INTEGER, PRIVATE, SAVE  :: iguide_read,iguide_int,iguide_sav
    22   INTEGER, PRIVATE, SAVE  :: nlevnc
     23  INTEGER, PRIVATE, SAVE  :: nlevnc, guide_plevs
    2324  LOGICAL, PRIVATE, SAVE  :: guide_u,guide_v,guide_T,guide_Q,guide_P
    2425  LOGICAL, PRIVATE, SAVE  :: guide_hr,guide_teta 
    2526  LOGICAL, PRIVATE, SAVE  :: guide_BL,guide_reg,guide_add,gamma4,guide_zon
    26   LOGICAL, PRIVATE, SAVE  :: guide_modele,invert_p,invert_y,ini_anal
    27   LOGICAL, PRIVATE, SAVE  :: guide_2D,guide_sav
     27  LOGICAL, PRIVATE, SAVE  :: invert_p,invert_y,ini_anal
     28  LOGICAL, PRIVATE, SAVE  :: guide_2D,guide_sav,guide_modele
     29!FC
     30  LOGICAL, PRIVATE, SAVE  :: convert_Pa
    2831 
    2932  REAL, PRIVATE, SAVE     :: tau_min_u,tau_max_u
    … …  
    4952  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: tnat1,tnat2
    5053  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: qnat1,qnat2
     54  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: pnat1,pnat2
    5155  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: psnat1,psnat2
    5256  REAL, ALLOCATABLE, DIMENSION(:),     PRIVATE, SAVE   :: apnc,bpnc
    … …  
    7579    CHARACTER (len = 80)   :: abort_message
    7680    CHARACTER (len = 20)   :: modname = 'guide_init'
     81    CHARACTER (len = 20)   :: namedim
    7782
    7883! ---------------------------------------------
    … …  
    140145        iguide_int=day_step*iguide_int
    141146    ENDIF
    142     CALL getpar('guide_modele',.false.,guide_modele,'guidage niveaux modele')
     147    CALL getpar('guide_plevs',0,guide_plevs,'niveaux pression fichiers guidage')
     148    ! Pour compatibilite avec ancienne version avec guide_modele
     149    CALL getpar('guide_modele',.false.,guide_modele,'niveaux pression ap+bp*psol')
     150    IF (guide_modele) THEN
     151        guide_plevs=1
     152    ENDIF
     153!FC
     154    CALL getpar('convert_Pa',.true.,convert_Pa,'Convert Pressure levels in Pa')
     155    ! Fin raccord
    143156    CALL getpar('ini_anal',.false.,ini_anal,'Etat initial = analyse')
    144157    CALL getpar('guide_invertp',.true.,invert_p,'niveaux p inverses')
    … …  
    153166! ---------------------------------------------
    154167    ncidpl=-99
    155     if (guide_modele) then
     168    if (guide_plevs.EQ.1) then
    156169       if (ncidpl.eq.-99) then
    157170          rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl)
    158171          if (rcod.NE.NF_NOERR) THEN
    159              CALL abort_gcm(modname, &
    160                   'Guide: probleme -> pas de fichier apbp.nc',1)
     172             abort_message=' Nudging error -> no file apbp.nc'
     173             CALL abort_gcm(modname,abort_message,1)
    161174          endif
    162175       endif
    163     else
    164          if (guide_u) then
     176    elseif (guide_plevs.EQ.2) then
     177       if (ncidpl.EQ.-99) then
     178          rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl)
     179          if (rcod.NE.NF_NOERR) THEN
     180             abort_message=' Nudging error -> no file P.nc'
     181             CALL abort_gcm(modname,abort_message,1)
     182          endif
     183       endif
     184
     185    elseif (guide_u) then
    165186           if (ncidpl.eq.-99) then
    166187               rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
    167188               if (rcod.NE.NF_NOERR) THEN
    168189                  CALL abort_gcm(modname, &
    169                        'Guide: probleme -> pas de fichier u.nc',1)
     190                       ' Nudging error -> no file u.nc',1)
    170191               endif
    171192           endif
    172          elseif (guide_v) then
     193
     194    elseif (guide_v) then
    173195           if (ncidpl.eq.-99) then
    174196               rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
    175197               if (rcod.NE.NF_NOERR) THEN
    176198                  CALL abort_gcm(modname, &
    177                        'Guide: probleme -> pas de fichier v.nc',1)
     199                       ' Nudging error -> no file v.nc',1)
    178200               endif
    179201           endif
    180          elseif (guide_T) then
     202    elseif (guide_T) then
    181203           if (ncidpl.eq.-99) then
    182204               rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
    183205               if (rcod.NE.NF_NOERR) THEN
    184206                  CALL abort_gcm(modname, &
    185                        'Guide: probleme -> pas de fichier T.nc',1)
     207                       ' Nudging error -> no file T.nc',1)
    186208               endif
    187209           endif
    188          elseif (guide_Q) then
     210    elseif (guide_Q) then
    189211           if (ncidpl.eq.-99) then
    190212               rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
    191213               if (rcod.NE.NF_NOERR) THEN
    192214                  CALL abort_gcm(modname, &
    193                        'Guide: probleme -> pas de fichier hur.nc',1)
     215                       ' Nudging error -> no file hur.nc',1)
    194216               endif
    195217           endif
    196          endif
     218
     219
    197220    endif
    198221    error=NF_INQ_DIMID(ncidpl,'LEVEL',rid)
    199222    IF (error.NE.NF_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid)
    200223    IF (error.NE.NF_NOERR) THEN
    201         CALL abort_gcm(modname,'Guide: probleme lecture niveaux pression',1)
     224        CALL abort_gcm(modname,'Nudging: error reading pressure levels',1)
    202225    ENDIF
    203226    error=NF_INQ_DIMLEN(ncidpl,rid,nlevnc)
    204     print *,'Guide: nombre niveaux vert. nlevnc', nlevnc
     227    write(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc
    205228    rcod = nf90_close(ncidpl)
    206229
    … …  
    208231! Allocation des variables
    209232! ---------------------------------------------
    210     abort_message='pb in allocation guide'
     233    abort_message='nudging allocation error'
    211234
    212235    ALLOCATE(apnc(nlevnc), stat = error)
    … …  
    278301    ENDIF
    279302
    280     IF (guide_P.OR.guide_modele) THEN
     303    IF (guide_plevs.EQ.2) THEN
     304        ALLOCATE(pnat1(iip1,jjp1,nlevnc), stat = error)
     305        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
     306        ALLOCATE(pnat2(iip1,jjp1,nlevnc), stat = error)
     307        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
     308        pnat1=0.;pnat2=0.;
     309    ENDIF
     310
     311    IF (guide_P.OR.guide_plevs.EQ.1) THEN
    281312        ALLOCATE(psnat1(iip1,jjp1), stat = error)
    282313        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
    … …  
    305336    IF (guide_T) tnat1=tnat2
    306337    IF (guide_Q) qnat1=qnat2
    307     IF (guide_P.OR.guide_modele) psnat1=psnat2
     338    IF (guide_plevs.EQ.2) pnat1=pnat2
     339    IF (guide_P.OR.guide_plevs.EQ.1) psnat1=psnat2
    308340
    309341  END SUBROUTINE guide_init
    … …  
    312344  SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps)
    313345
     346    USE exner_hyb_m, ONLY: exner_hyb
     347    USE exner_milieu_m, ONLY: exner_milieu
    314348    USE control_mod, ONLY: day_step, iperiod
    315     USE comconst_mod, ONLY: dtvr, daysec
    316     USE comvert_mod, ONLY: ap, bp, preff, presnivs
     349    USE comconst_mod, ONLY: cpp, dtvr, daysec,kappa
     350    USE comvert_mod, ONLY: ap, bp, preff, presnivs, pressure_exner
    317351 
    318352    IMPLICIT NONE
    … …  
    331365    LOGICAL       :: f_out ! sortie guidage
    332366    REAL, DIMENSION (ip1jmp1,llm) :: f_add ! var aux: champ de guidage
    333     REAL, DIMENSION (ip1jmp1,llm) :: p ! besoin si guide_P
     367    REAL :: pk(ip1jmp1,llm) ! Exner at mid-layers
     368    REAL :: pks(ip1jmp1) ! Exner at the surface
     369    REAL :: unskap ! 1./kappa
     370    REAL, DIMENSION (ip1jmp1,llmp1) :: p ! Pressure at inter-layers
    334371    ! Compteurs temps:
    335372    INTEGER, SAVE :: step_rea,count_no_rea,itau_test ! lecture guidage
    … …  
    339376   
    340377    INTEGER       :: l
     378    CHARACTER(LEN=20) :: modname="guide_main"
    341379
    342380!-----------------------------------------------------------------------
    … …  
    379417        ENDIF
    380418! Verification structure guidage
    381         IF (guide_u) THEN
    382             CALL writefield('unat',unat1)
    383             CALL writefield('ucov',RESHAPE(ucov,(/iip1,jjp1,llm/)))
    384         ENDIF
    385         IF (guide_T) THEN
    386             CALL writefield('tnat',tnat1)
    387             CALL writefield('teta',RESHAPE(teta,(/iip1,jjp1,llm/)))
    388         ENDIF
     419!        IF (guide_u) THEN
     420!            CALL writefield('unat',unat1)
     421!            CALL writefield('ucov',RESHAPE(ucov,(/iip1,jjp1,llm/)))
     422!        ENDIF
     423!        IF (guide_T) THEN
     424!            CALL writefield('tnat',tnat1)
     425!            CALL writefield('teta',RESHAPE(teta,(/iip1,jjp1,llm/)))
     426!        ENDIF
    389427
    390428    ENDIF !first
    … …  
    404442      IF (reste.EQ.0.) THEN
    405443          IF (itau_test.EQ.itau) THEN
    406               write(*,*)'deuxieme passage de advreel a itau=',itau
    407               stop
     444            write(*,*)trim(modname)//' second pass in advreel at itau=',&
     445            itau
     446            stop
    408447          ELSE
    409448              IF (guide_v) vnat1=vnat2
    … …  
    411450              IF (guide_T) tnat1=tnat2
    412451              IF (guide_Q) qnat1=qnat2
    413               IF (guide_P.OR.guide_modele) psnat1=psnat2
     452              IF (guide_plevs.EQ.2) pnat1=pnat2
     453              IF (guide_P.OR.guide_plevs.EQ.1) psnat1=psnat2
    414454              step_rea=step_rea+1
    415455              itau_test=itau
    416               print*,'Lecture fichiers guidage, pas ',step_rea, &
    417                     'apres ',count_no_rea,' non lectures'
     456              write(*,*)trim(modname)//' Reading nudging files, step ',&
     457                     step_rea,'after ',count_no_rea,' skips'
    418458              IF (guide_2D) THEN
    419459                  CALL guide_read2D(step_rea)
    … …  
    447487! Sauvegarde du guidage?
    448488    f_out=((MOD(itau,iguide_sav).EQ.0).AND.guide_sav) 
    449     IF (f_out) CALL guide_out("SP",jjp1,1,ps)
     489    IF (f_out) THEN
     490      ! compute pressures at layer interfaces
     491      CALL pression(ip1jmp1,ap,bp,ps,p)
     492      if (pressure_exner) then
     493        call exner_hyb(ip1jmp1,ps,p,pks,pk)
     494      else
     495        call exner_milieu(ip1jmp1,ps,p,pks,pk)
     496      endif
     497      unskap=1./kappa
     498      ! Now compute pressures at mid-layer
     499      do l=1,llm
     500        p(:,l)=preff*(pk(:,l)/cpp)**unskap
     501      enddo
     502      CALL guide_out("SP",jjp1,llm,p(:,1:llm))
     503    ENDIF
    450504   
    451505    if (guide_u) then
    … …  
    483537        if (guide_zon) CALL guide_zonave(2,jjp1,1,f_add(1:ip1jmp1,1))
    484538        CALL guide_addfield(ip1jmp1,1,f_add(1:ip1jmp1,1),alpha_P)
    485         IF (f_out) CALL guide_out("ps",jjp1,1,f_add(1:ip1jmp1,1)/factt)
     539!        IF (f_out) CALL guide_out("ps",jjp1,1,f_add(1:ip1jmp1,1)/factt)
    486540        ps=ps+f_add(1:ip1jmp1,1)
    487541        CALL pression(ip1jmp1,ap,bp,ps,p)
    … …  
    637691 
    638692  INTEGER                            :: i,j,l,ij
     693  CHARACTER(LEN=20),PARAMETER :: modname="guide_interp"
    639694 
    640     print *,'Guide: conversion variables guidage'
     695    write(*,*)trim(modname)//': interpolate nudging variables'
    641696! -----------------------------------------------------------------
    642697! Calcul des niveaux de pression champs guidage
    … …  
    664719    if (first) then
    665720        first=.FALSE.
    666         print*,'Guide: verification ordre niveaux verticaux'
    667         print*,'LMDZ :'
     721        write(*,*)trim(modname)//' : check vertical level order'
     722        write(*,*)trim(modname)//' LMDZ :'
    668723        do l=1,llm
    669             print*,'PL(',l,')=',(ap(l)+ap(l+1))/2. &
     724          write(*,*)trim(modname)//' PL(',l,')=',(ap(l)+ap(l+1))/2. &
    670725                  +psi(1,jjp1)*(bp(l)+bp(l+1))/2.
    671726        enddo
    672         print*,'Fichiers guidage'
     727        write(*,*)trim(modname)//' nudging file :'
    673728        do l=1,nlevnc
    674              print*,'PL(',l,')=',plnc2(1,1,l)
     729          write(*,*)trim(modname)//' PL(',l,')=',plnc2(1,1,l)
    675730        enddo
    676         print *,'inversion de l''ordre: invert_p=',invert_p
     731        write(*,*)trim(modname)//' invert ordering: invert_p=',invert_p
    677732        if (guide_u) then
    678733            do l=1,nlevnc
    679                 print*,'U(',l,')=',unat2(1,1,l)
     734              write(*,*)trim(modname)//' U(',l,')=',unat2(1,1,l)
    680735            enddo
    681736        endif
    682737        if (guide_T) then
    683738            do l=1,nlevnc
    684                 print*,'T(',l,')=',tnat2(1,1,l)
     739              write(*,*)trim(modname)//' T(',l,')=',tnat2(1,1,l)
    685740            enddo
    686741        endif
    … …  
    881936    real alphamin,alphamax,xi
    882937    integer i,j,ilon,ilat
     938    character(len=20),parameter :: modname="tau2alpha"
    883939
    884940
    … …  
    9691025            ! Calcul de gamma
    9701026            if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then
    971                  print*,'ATTENTION modele peu zoome'
    972                  print*,'ATTENTION on prend une constante de guidage cste'
    973                  gamma=0.
     1027              write(*,*)trim(modname)//' ATTENTION modele peu zoome'
     1028              write(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste'
     1029              gamma=0.
    9741030            else
    975                 gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
    976                 print*,'gamma=',gamma
    977                 if (gamma.lt.1.e-5) then
    978                   print*,'gamma =',gamma,'<1e-5'
    979                   stop
    980                 endif
    981                 gamma=log(0.5)/log(gamma)
    982                 if (gamma4) then
    983                   gamma=min(gamma,4.)
    984                 endif
    985                 print*,'gamma=',gamma
     1031              gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
     1032              write(*,*)trim(modname)//' gamma=',gamma
     1033              if (gamma.lt.1.e-5) then
     1034                write(*,*)trim(modname)//' gamma =',gamma,'<1e-5'
     1035                stop
     1036              endif
     1037              gamma=log(0.5)/log(gamma)
     1038              if (gamma4) then
     1039                gamma=min(gamma,4.)
     1040              endif
     1041              write(*,*)trim(modname)//' gamma=',gamma
    9861042            endif
    9871043        ENDIF !first
    … …  
    10241080    IMPLICIT NONE
    10251081
    1026 #include "netcdf.inc"
    1027 #include "dimensions.h"
    1028 #include "paramet.h"
     1082    include "netcdf.inc"
     1083    include "dimensions.h"
     1084    include "paramet.h"
    10291085
    10301086    INTEGER, INTENT(IN)   :: timestep
    … …  
    10321088    LOGICAL, SAVE         :: first=.TRUE.
    10331089! Identification fichiers et variables NetCDF:
    1034     INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidQ
    1035     INTEGER, SAVE         :: varidQ,ncidt,varidt,ncidps,varidps
    1036     INTEGER               :: ncidpl,varidpl,varidap,varidbp
     1090    INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidp,varidp
     1091    INTEGER, SAVE         :: ncidQ,varidQ,ncidt,varidt,ncidps,varidps
     1092    INTEGER               :: ncidpl,varidpl,varidap,varidbp,dimid,lendim
    10371093! Variables auxiliaires NetCDF:
    10381094    INTEGER, DIMENSION(4) :: start,count
    10391095    INTEGER               :: status,rcode
    1040 
    10411096    CHARACTER (len = 80)   :: abort_message
    10421097    CHARACTER (len = 20)   :: modname = 'guide_read'
     1098    CHARACTER (len = 20)   :: namedim
     1099
    10431100! -----------------------------------------------------------------
    10441101! Premier appel: initialisation de la lecture des fichiers
    … …  
    10461103    if (first) then
    10471104         ncidpl=-99
    1048          print*,'Guide: ouverture des fichiers guidage '
     1105         write(*,*),trim(modname)//': opening nudging files '
    10491106! Niveaux de pression si non constants
    1050          if (guide_modele) then
    1051              print *,'Lecture du guidage sur niveaux modele'
     1107         if (guide_plevs.EQ.1) then
     1108             write(*,*),trim(modname)//' Reading nudging on model levels'
    10521109             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    10531110             IF (rcode.NE.NF_NOERR) THEN
    1054               print *,'Guide: probleme -> pas de fichier apbp.nc'
     1111              abort_message='Nudging: error -> no file apbp.nc'
    10551112              CALL abort_gcm(modname,abort_message,1)
    10561113             ENDIF
    10571114             rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
    10581115             IF (rcode.NE.NF_NOERR) THEN
    1059               print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc'
     1116              abort_message='Nudging: error -> no AP variable in file apbp.nc'
    10601117              CALL abort_gcm(modname,abort_message,1)
    10611118             ENDIF
    10621119             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    10631120             IF (rcode.NE.NF_NOERR) THEN
    1064               print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc'
     1121              abort_message='Nudging: error -> no BP variable in file apbp.nc'
    10651122              CALL abort_gcm(modname,abort_message,1)
    10661123             ENDIF
    1067              print*,'ncidpl,varidap',ncidpl,varidap
     1124             write(*,*),trim(modname)//' ncidpl,varidap',ncidpl,varidap
    10681125         endif
     1126
     1127! Pression si guidage sur niveaux P variables
     1128         if (guide_plevs.EQ.2) then
     1129             rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
     1130             IF (rcode.NE.NF_NOERR) THEN
     1131              abort_message='Nudging: error -> no file P.nc'
     1132              CALL abort_gcm(modname,abort_message,1)
     1133             ENDIF
     1134             rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
     1135             IF (rcode.NE.NF_NOERR) THEN
     1136              abort_message='Nudging: error -> no PRES variable in file P.nc'
     1137              CALL abort_gcm(modname,abort_message,1)
     1138             ENDIF
     1139             write(*,*),trim(modname)//' ncidp,varidp',ncidp,varidp
     1140             if (ncidpl.eq.-99) ncidpl=ncidp
     1141         endif
     1142
    10691143! Vent zonal
    10701144         if (guide_u) then
    10711145             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    10721146             IF (rcode.NE.NF_NOERR) THEN
    1073               print *,'Guide: probleme -> pas de fichier u.nc'
     1147              abort_message='Nudging: error -> no file u.nc'
    10741148              CALL abort_gcm(modname,abort_message,1)
    10751149             ENDIF
    10761150             rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
    10771151             IF (rcode.NE.NF_NOERR) THEN
    1078               print *,'Guide: probleme -> pas de variable UWND, fichier u.nc'
     1152              abort_message='Nudging: error -> no UWND variable in file u.nc'
    10791153              CALL abort_gcm(modname,abort_message,1)
    10801154             ENDIF
    1081              print*,'ncidu,varidu',ncidu,varidu
     1155             write(*,*),trim(modname)//' ncidu,varidu',ncidu,varidu
    10821156             if (ncidpl.eq.-99) ncidpl=ncidu
     1157
     1158             status=NF90_INQ_DIMID(ncidu, "LONU", dimid)
     1159             status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim)
     1160             IF (lendim .NE. iip1) THEN
     1161                abort_message='dimension LONU different from iip1 in u.nc'
     1162                CALL abort_gcm(modname,abort_message,1)
     1163             ENDIF
     1164
     1165             status=NF90_INQ_DIMID(ncidu, "LATU", dimid)
     1166             status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim)
     1167             IF (lendim .NE. jjp1) THEN
     1168                abort_message='dimension LATU different from jjp1 in u.nc'
     1169                CALL abort_gcm(modname,abort_message,1)
     1170             ENDIF
     1171
    10831172         endif
     1173
    10841174! Vent meridien
    10851175         if (guide_v) then
    10861176             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    10871177             IF (rcode.NE.NF_NOERR) THEN
    1088               print *,'Guide: probleme -> pas de fichier v.nc'
     1178              abort_message='Nudging: error -> no file v.nc'
    10891179              CALL abort_gcm(modname,abort_message,1)
    10901180             ENDIF
    10911181             rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    10921182             IF (rcode.NE.NF_NOERR) THEN
    1093               print *,'Guide: probleme -> pas de variable VWND, fichier v.nc'
     1183              abort_message='Nudging: error -> no VWND variable in file v.nc'
    10941184              CALL abort_gcm(modname,abort_message,1)
    10951185             ENDIF
    1096              print*,'ncidv,varidv',ncidv,varidv
     1186             write(*,*),trim(modname)//' ncidv,varidv',ncidv,varidv
    10971187             if (ncidpl.eq.-99) ncidpl=ncidv
     1188             
     1189             status=NF90_INQ_DIMID(ncidv, "LONV", dimid)
     1190             status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim)
     1191             
     1192                IF (lendim .NE. iip1) THEN
     1193                abort_message='dimension LONV different from iip1 in v.nc'
     1194                CALL abort_gcm(modname,abort_message,1)
     1195             ENDIF
     1196
     1197
     1198             status=NF90_INQ_DIMID(ncidv, "LATV", dimid)
     1199             status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim)
     1200             IF (lendim .NE. jjm) THEN
     1201                abort_message='dimension LATV different from jjm in v.nc'
     1202                CALL abort_gcm(modname,abort_message,1)
     1203             ENDIF
     1204       
    10981205         endif
     1206
    10991207! Temperature
    11001208         if (guide_T) then
    11011209             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    11021210             IF (rcode.NE.NF_NOERR) THEN
    1103               print *,'Guide: probleme -> pas de fichier T.nc'
     1211              abort_message='Nudging: error -> no file T.nc'
    11041212              CALL abort_gcm(modname,abort_message,1)
    11051213             ENDIF
    11061214             rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    11071215             IF (rcode.NE.NF_NOERR) THEN
    1108               print *,'Guide: probleme -> pas de variable AIR, fichier T.nc'
     1216              abort_message='Nudging: error -> no AIR variable in file T.nc'
    11091217              CALL abort_gcm(modname,abort_message,1)
    11101218             ENDIF
    1111              print*,'ncidT,varidT',ncidt,varidt
     1219             write(*,*),trim(modname)//' ncidT,varidT',ncidt,varidt
    11121220             if (ncidpl.eq.-99) ncidpl=ncidt
     1221
     1222             status=NF90_INQ_DIMID(ncidt, "LONV", dimid)
     1223             status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim)
     1224             IF (lendim .NE. iip1) THEN
     1225                abort_message='dimension LONV different from iip1 in T.nc'
     1226                CALL abort_gcm(modname,abort_message,1)
     1227             ENDIF
     1228
     1229             status=NF90_INQ_DIMID(ncidt, "LATU", dimid)
     1230             status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim)
     1231             IF (lendim .NE. jjp1) THEN
     1232                abort_message='dimension LATU different from jjp1 in T.nc'
     1233                CALL abort_gcm(modname,abort_message,1)
     1234             ENDIF
     1235
    11131236         endif
     1237
    11141238! Humidite
    11151239         if (guide_Q) then
    11161240             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    11171241             IF (rcode.NE.NF_NOERR) THEN
    1118               print *,'Guide: probleme -> pas de fichier hur.nc'
     1242              abort_message='Nudging: error -> no file hur.nc'
    11191243              CALL abort_gcm(modname,abort_message,1)
    11201244             ENDIF
    11211245             rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    11221246             IF (rcode.NE.NF_NOERR) THEN
    1123               print *,'Guide: probleme -> pas de variable RH, fichier hur.nc'
     1247              abort_message='Nudging: error -> no RH variable in file hur.nc'
    11241248              CALL abort_gcm(modname,abort_message,1)
    11251249             ENDIF
    1126              print*,'ncidQ,varidQ',ncidQ,varidQ
     1250             write(*,*),trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
    11271251             if (ncidpl.eq.-99) ncidpl=ncidQ
     1252
     1253             status=NF90_INQ_DIMID(ncidQ, "LONV", dimid)
     1254             status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim)
     1255             IF (lendim .NE. iip1) THEN
     1256                abort_message='dimension LONV different from iip1 in hur.nc'
     1257                CALL abort_gcm(modname,abort_message,1)
     1258             ENDIF
     1259
     1260             status=NF90_INQ_DIMID(ncidQ, "LATU", dimid)
     1261             status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim)
     1262             IF (lendim .NE. jjp1) THEN
     1263                abort_message='dimension LATU different from jjp1 in hur.nc'
     1264                CALL abort_gcm(modname,abort_message,1)
     1265             ENDIF
     1266
    11281267         endif
     1268
    11291269! Pression de surface
    11301270         if ((guide_P).OR.(guide_modele)) then
    11311271             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    11321272             IF (rcode.NE.NF_NOERR) THEN
    1133               print *,'Guide: probleme -> pas de fichier ps.nc'
     1273              abort_message='Nudging: error -> no file ps.nc'
    11341274              CALL abort_gcm(modname,abort_message,1)
    11351275             ENDIF
    11361276             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    11371277             IF (rcode.NE.NF_NOERR) THEN
    1138               print *,'Guide: probleme -> pas de variable SP, fichier ps.nc'
     1278              abort_message='Nudging: error -> no SP variable in file ps.nc'
    11391279              CALL abort_gcm(modname,abort_message,1)
    11401280             ENDIF
    1141              print*,'ncidps,varidps',ncidps,varidps
     1281             write(*,*),trim(modname)//' ncidps,varidps',ncidps,varidps
    11421282         endif
    11431283! Coordonnee verticale
    1144          if (.not.guide_modele) then
     1284         if (guide_plevs.EQ.0) then
    11451285              rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    11461286              IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    1147               print*,'ncidpl,varidpl',ncidpl,varidpl
     1287              write(*,*),trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
    11481288         endif
    11491289! Coefs ap, bp pour calcul de la pression aux differents niveaux
    1150          if (guide_modele) then
     1290         if (guide_plevs.EQ.1) then
    11511291#ifdef NC_DOUBLE
    11521292             status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc)
    … …  
    11561296             status=NF_GET_VARA_REAL(ncidpl,varidbp,1,nlevnc,bpnc)
    11571297#endif
    1158          else
     1298         ELSEIF (guide_plevs.EQ.0) THEN
    11591299#ifdef NC_DOUBLE
    11601300             status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc)
    … …  
    11621302             status=NF_GET_VARA_REAL(ncidpl,varidpl,1,nlevnc,apnc)
    11631303#endif
    1164              apnc=apnc*100.! conversion en Pascals
     1304!FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous
     1305             IF(convert_Pa) apnc=apnc*100.! conversion en Pascals
    11651306             bpnc(:)=0.
    11661307         endif
    … …  
    11821323     count(3)=nlevnc
    11831324     count(4)=1
     1325
     1326! Pression
     1327     if (guide_plevs.EQ.2) then
     1328#ifdef NC_DOUBLE
     1329         status=NF_GET_VARA_DOUBLE(ncidp,varidp,start,count,pnat2)
     1330#else
     1331         status=NF_GET_VARA_REAL(ncidp,varidp,start,count,pnat2)
     1332#endif
     1333         IF (invert_y) THEN
     1334!           PRINT*,"Invertion impossible actuellement"
     1335!           CALL abort_gcm(modname,abort_message,1)
     1336           CALL invert_lat(iip1,jjp1,nlevnc,pnat2)
     1337         ENDIF
     1338     endif
    11841339
    11851340!  Vent zonal
    … …  
    12571412    IMPLICIT NONE
    12581413
    1259 #include "netcdf.inc"
    1260 #include "dimensions.h"
    1261 #include "paramet.h"
     1414    include "netcdf.inc"
     1415    include "dimensions.h"
     1416    include "paramet.h"
    12621417
    12631418    INTEGER, INTENT(IN)   :: timestep
    … …  
    12651420    LOGICAL, SAVE         :: first=.TRUE.
    12661421! Identification fichiers et variables NetCDF:
    1267     INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidQ
    1268     INTEGER, SAVE         :: varidQ,ncidt,varidt,ncidps,varidps
     1422    INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidp,varidp
     1423    INTEGER, SAVE         :: ncidQ,varidQ,ncidt,varidt,ncidps,varidps
    12691424    INTEGER               :: ncidpl,varidpl,varidap,varidbp
    12701425! Variables auxiliaires NetCDF:
    … …  
    12831438    if (first) then
    12841439         ncidpl=-99
    1285          print*,'Guide: ouverture des fichiers guidage '
    1286 ! Niveaux de pression si non constants
    1287          if (guide_modele) then
    1288              print *,'Lecture du guidage sur niveaux modele'
    1289              rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    1290              IF (rcode.NE.NF_NOERR) THEN
    1291               print *,'Guide: probleme -> pas de fichier apbp.nc'
    1292               CALL abort_gcm(modname,abort_message,1)
    1293              ENDIF
    1294              rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
    1295              IF (rcode.NE.NF_NOERR) THEN
    1296               print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc'
    1297               CALL abort_gcm(modname,abort_message,1)
    1298              ENDIF
    1299              rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    1300              IF (rcode.NE.NF_NOERR) THEN
    1301               print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc'
    1302               CALL abort_gcm(modname,abort_message,1)
    1303              ENDIF
    1304              print*,'ncidpl,varidap',ncidpl,varidap
     1440         write(*,*)trim(modname)//' : opening nudging files '
     1441! Ap et Bp si niveaux de pression hybrides
     1442         if (guide_plevs.EQ.1) then
     1443           write(*,*)trim(modname)//' Reading nudging on model levels'
     1444           rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
     1445           IF (rcode.NE.NF_NOERR) THEN
     1446             abort_message='Nudging: error -> no file apbp.nc'
     1447           CALL abort_gcm(modname,abort_message,1)
     1448           ENDIF
     1449           rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
     1450           IF (rcode.NE.NF_NOERR) THEN
     1451             abort_message='Nudging: error -> no AP variable in file apbp.nc'
     1452           CALL abort_gcm(modname,abort_message,1)
     1453           ENDIF
     1454           rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
     1455           IF (rcode.NE.NF_NOERR) THEN
     1456             abort_message='Nudging: error -> no BP variable in file apbp.nc'
     1457             CALL abort_gcm(modname,abort_message,1)
     1458           ENDIF
     1459           write(*,*)trim(modname)//'ncidpl,varidap',ncidpl,varidap
     1460         endif
     1461! Pression
     1462         if (guide_plevs.EQ.2) then
     1463           rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
     1464           IF (rcode.NE.NF_NOERR) THEN
     1465             abort_message='Nudging: error -> no file P.nc'
     1466             CALL abort_gcm(modname,abort_message,1)
     1467           ENDIF
     1468           rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
     1469           IF (rcode.NE.NF_NOERR) THEN
     1470             abort_message='Nudging: error -> no PRES variable in file P.nc'
     1471             CALL abort_gcm(modname,abort_message,1)
     1472           ENDIF
     1473           write(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp
     1474           if (ncidpl.eq.-99) ncidpl=ncidp
    13051475         endif
    13061476! Vent zonal
    13071477         if (guide_u) then
    1308              rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    1309              IF (rcode.NE.NF_NOERR) THEN
    1310               print *,'Guide: probleme -> pas de fichier u.nc'
    1311               CALL abort_gcm(modname,abort_message,1)
    1312              ENDIF
    1313              rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
    1314              IF (rcode.NE.NF_NOERR) THEN
    1315               print *,'Guide: probleme -> pas de variable UWND, fichier u.nc'
    1316               CALL abort_gcm(modname,abort_message,1)
    1317              ENDIF
    1318              print*,'ncidu,varidu',ncidu,varidu
    1319              if (ncidpl.eq.-99) ncidpl=ncidu
     1478           rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
     1479           IF (rcode.NE.NF_NOERR) THEN
     1480             abort_message='Nudging: error -> no file u.nc'
     1481             CALL abort_gcm(modname,abort_message,1)
     1482           ENDIF
     1483           rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
     1484           IF (rcode.NE.NF_NOERR) THEN
     1485             abort_message='Nudging: error -> no UWND variable in file u.nc'
     1486             CALL abort_gcm(modname,abort_message,1)
     1487           ENDIF
     1488           write(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu
     1489           if (ncidpl.eq.-99) ncidpl=ncidu
    13201490         endif
    13211491! Vent meridien
    13221492         if (guide_v) then
    1323              rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    1324              IF (rcode.NE.NF_NOERR) THEN
    1325               print *,'Guide: probleme -> pas de fichier v.nc'
    1326               CALL abort_gcm(modname,abort_message,1)
    1327              ENDIF
    1328              rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    1329              IF (rcode.NE.NF_NOERR) THEN
    1330               print *,'Guide: probleme -> pas de variable VWND, fichier v.nc'
    1331               CALL abort_gcm(modname,abort_message,1)
    1332              ENDIF
    1333              print*,'ncidv,varidv',ncidv,varidv
    1334              if (ncidpl.eq.-99) ncidpl=ncidv
     1493           rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
     1494           IF (rcode.NE.NF_NOERR) THEN
     1495             abort_message='Nudging: error -> no file v.nc'
     1496             CALL abort_gcm(modname,abort_message,1)
     1497           ENDIF
     1498           rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
     1499           IF (rcode.NE.NF_NOERR) THEN
     1500             abort_message='Nudging: error -> no VWND variable in file v.nc'
     1501             CALL abort_gcm(modname,abort_message,1)
     1502           ENDIF
     1503           write(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv
     1504           if (ncidpl.eq.-99) ncidpl=ncidv
    13351505         endif
    13361506! Temperature
    13371507         if (guide_T) then
    1338              rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    1339              IF (rcode.NE.NF_NOERR) THEN
    1340               print *,'Guide: probleme -> pas de fichier T.nc'
    1341               CALL abort_gcm(modname,abort_message,1)
    1342              ENDIF
    1343              rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    1344              IF (rcode.NE.NF_NOERR) THEN
    1345               print *,'Guide: probleme -> pas de variable AIR, fichier T.nc'
    1346               CALL abort_gcm(modname,abort_message,1)
    1347              ENDIF
    1348              print*,'ncidT,varidT',ncidt,varidt
    1349              if (ncidpl.eq.-99) ncidpl=ncidt
     1508           rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
     1509           IF (rcode.NE.NF_NOERR) THEN
     1510             abort_message='Nudging: error -> no file T.nc'
     1511             CALL abort_gcm(modname,abort_message,1)
     1512           ENDIF
     1513           rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
     1514           IF (rcode.NE.NF_NOERR) THEN
     1515             abort_message='Nudging: error -> no AIR variable in file T.nc'
     1516             CALL abort_gcm(modname,abort_message,1)
     1517           ENDIF
     1518           write(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt
     1519           if (ncidpl.eq.-99) ncidpl=ncidt
    13501520         endif
    13511521! Humidite
    13521522         if (guide_Q) then
    1353              rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    1354              IF (rcode.NE.NF_NOERR) THEN
    1355               print *,'Guide: probleme -> pas de fichier hur.nc'
    1356               CALL abort_gcm(modname,abort_message,1)
    1357              ENDIF
    1358              rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    1359              IF (rcode.NE.NF_NOERR) THEN
    1360               print *,'Guide: probleme -> pas de variable RH, fichier hur.nc'
    1361               CALL abort_gcm(modname,abort_message,1)
    1362              ENDIF
    1363              print*,'ncidQ,varidQ',ncidQ,varidQ
    1364              if (ncidpl.eq.-99) ncidpl=ncidQ
     1523           rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
     1524           IF (rcode.NE.NF_NOERR) THEN
     1525             abort_message='Nudging: error -> no file hur.nc'
     1526             CALL abort_gcm(modname,abort_message,1)
     1527           ENDIF
     1528           rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
     1529           IF (rcode.NE.NF_NOERR) THEN
     1530             abort_message='Nudging: error -> no RH,variable in file hur.nc'
     1531             CALL abort_gcm(modname,abort_message,1)
     1532           ENDIF
     1533           write(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
     1534           if (ncidpl.eq.-99) ncidpl=ncidQ
    13651535         endif
    13661536! Pression de surface
    13671537         if ((guide_P).OR.(guide_modele)) then
    1368              rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    1369              IF (rcode.NE.NF_NOERR) THEN
    1370               print *,'Guide: probleme -> pas de fichier ps.nc'
    1371               CALL abort_gcm(modname,abort_message,1)
    1372              ENDIF
    1373              rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    1374              IF (rcode.NE.NF_NOERR) THEN
    1375               print *,'Guide: probleme -> pas de variable SP, fichier ps.nc'
    1376               CALL abort_gcm(modname,abort_message,1)
    1377              ENDIF
    1378              print*,'ncidps,varidps',ncidps,varidps
     1538           rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
     1539           IF (rcode.NE.NF_NOERR) THEN
     1540             abort_message='Nudging: error -> no file ps.nc'
     1541             CALL abort_gcm(modname,abort_message,1)
     1542           ENDIF
     1543           rcode = nf90_inq_varid(ncidps, 'SP', varidps)
     1544           IF (rcode.NE.NF_NOERR) THEN
     1545             abort_message='Nudging: error -> no SP variable in file ps.nc'
     1546             CALL abort_gcm(modname,abort_message,1)
     1547           ENDIF
     1548           write(*,*)trim(modname)//' ncidps,varidps',ncidps,varidps
    13791549         endif
    13801550! Coordonnee verticale
    1381          if (.not.guide_modele) then
    1382               rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    1383               IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    1384               print*,'ncidpl,varidpl',ncidpl,varidpl
     1551         if (guide_plevs.EQ.0) then
     1552           rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
     1553           IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
     1554           write(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
    13851555         endif
    13861556! Coefs ap, bp pour calcul de la pression aux differents niveaux
    1387          if (guide_modele) then
     1557         if (guide_plevs.EQ.1) then
    13881558#ifdef NC_DOUBLE
    13891559             status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc)
    … …  
    13931563             status=NF_GET_VARA_REAL(ncidpl,varidbp,1,nlevnc,bpnc)
    13941564#endif
    1395          else
     1565         elseif (guide_plevs.EQ.0) THEN
    13961566#ifdef NC_DOUBLE
    13971567             status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc)
    … …  
    14201590     count(4)=1
    14211591
     1592!  Pression
     1593     if (guide_plevs.EQ.2) then
     1594#ifdef NC_DOUBLE
     1595         status=NF_GET_VARA_DOUBLE(ncidp,varidp,start,count,zu)
     1596#else
     1597         status=NF_GET_VARA_REAL(ncidp,varidp,start,count,zu)
     1598#endif
     1599         DO i=1,iip1
     1600             pnat2(i,:,:)=zu(:,:)
     1601         ENDDO
     1602
     1603         IF (invert_y) THEN
     1604!           PRINT*,"Invertion impossible actuellement"
     1605!           CALL abort_gcm(modname,abort_message,1)
     1606           CALL invert_lat(iip1,jjp1,nlevnc,pnat2)
     1607         ENDIF
     1608     endif
    14221609!  Vent zonal
    14231610     if (guide_u) then
    … …  
    14901677
    14911678!  Pression de surface
    1492      if ((guide_P).OR.(guide_modele))  then
     1679     if ((guide_P).OR.(guide_plevs.EQ.1))  then
    14931680         start(3)=timestep
    14941681         start(4)=0
    … …  
    15431730    INTEGER                :: ierr, varid,l
    15441731    REAL, DIMENSION (iip1,hsize,vsize) :: field2
    1545 
    1546     print *,'Guide: output timestep',timestep,'var ',varname
     1732    CHARACTER(LEN=20),PARAMETER :: modname="guide_out"
     1733
     1734    write(*,*)trim(modname)//': output timestep',timestep,'var ',varname
    15471735    IF (timestep.EQ.0) THEN
    15481736! ----------------------------------------------
    … …  
    15661754        ierr=NF_DEF_VAR(nid,"LEVEL",NF_FLOAT,1,id_lev,vid_lev)
    15671755        ierr=NF_DEF_VAR(nid,"cu",NF_FLOAT,2,(/id_lonu,id_latu/),vid_cu)
     1756        ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv)
    15681757        ierr=NF_DEF_VAR(nid,"au",NF_FLOAT,2,(/id_lonu,id_latu/),vid_au)
    1569         ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv)
    15701758        ierr=NF_DEF_VAR(nid,"av",NF_FLOAT,2,(/id_lonv,id_latv/),vid_av)
    15711759        call nf95_def_var(nid, "alpha_T", nf90_float, (/id_lonv, id_latu/), &
    … …  
    16041792! --------------------------------------------------------------------
    16051793        ierr = NF_REDEF(nid)
    1606 ! Surface pressure (GCM)
    1607         dim3=(/id_lonv,id_latu,id_tim/)
    1608         ierr = NF_DEF_VAR(nid,"SP",NF_FLOAT,3,dim3,varid)
     1794! Pressure (GCM)
     1795        dim4=(/id_lonv,id_latu,id_lev,id_tim/)
     1796        ierr = NF_DEF_VAR(nid,"SP",NF_FLOAT,4,dim4,varid)
    16091797! Surface pressure (guidage)
    16101798        IF (guide_P) THEN
    … …  
    16511839    SELECT CASE (varname)
    16521840    CASE ("SP","ps")
    1653         start=(/1,1,timestep,0/)
    1654         count=(/iip1,jjp1,1,0/)
     1841        start=(/1,1,1,timestep/)
     1842        count=(/iip1,jjp1,llm,1/)
    16551843    CASE ("v","va","vcov")
    16561844        start=(/1,1,1,timestep/)

  • LMDZ6/branches/Ocean_skin/libf/dyn3d/iniacademic.F90

    r2622 r4013  
    6767  LOGICAL ok_geost             ! Initialisation vent geost. ou nul
    6868  LOGICAL ok_pv                ! Polar Vortex
    69   REAL phi_pv,dphi_pv,gam_pv   ! Constantes pour polar vortex
     69  REAL phi_pv,dphi_pv,gam_pv,tetanoise   ! Constantes pour polar vortex
    7070
    7171  real zz,ran1
    … …  
    117117  CALL inigeom
    118118  CALL inifilr
     119
     120  ! Initialize pressure and mass field if read_start=.false.
     121  IF (.NOT. read_start) THEN
     122     ! surface pressure
     123     if (iflag_phys>2) then
     124        ! specific value for CMIP5 aqua/terra planets
     125        ! "Specify the initial dry mass to be equivalent to
     126        !  a global mean surface pressure (101325 minus 245) Pa."
     127        ps(:)=101080. 
     128     else
     129        ! use reference surface pressure
     130        ps(:)=preff
     131     endif
     132     ! ground geopotential
     133     phis(:)=0.
     134     CALL pression ( ip1jmp1, ap, bp, ps, p       )
     135     if (pressure_exner) then
     136       CALL exner_hyb( ip1jmp1, ps, p, pks, pk)
     137     else
     138       call exner_milieu(ip1jmp1,ps,p,pks,pk)
     139     endif
     140     CALL massdair(p,masse)
     141  ENDIF
    119142
    120143  if (llm == 1) then
    … …  
    167190     gam_pv=4.              ! -dT/dz vortex (in K/km)
    168191     CALL getin('gam_pv',gam_pv)
     192     tetanoise=0.005
     193     CALL getin('tetanoise',tetanoise)
     194
    169195
    170196     ! 2. Initialize fields towards which to relax
    … …  
    219245     ! 3. Initialize fields (if necessary)
    220246     IF (.NOT. read_start) THEN
    221         ! surface pressure
    222         if (iflag_phys>2) then
    223            ! specific value for CMIP5 aqua/terra planets
    224            ! "Specify the initial dry mass to be equivalent to
    225            !  a global mean surface pressure (101325 minus 245) Pa."
    226            ps(:)=101080. 
    227         else
    228            ! use reference surface pressure
    229            ps(:)=preff
    230         endif
    231        
    232         ! ground geopotential
    233         phis(:)=0.
    234 
    235         CALL pression ( ip1jmp1, ap, bp, ps, p       )
    236         if (pressure_exner) then
    237           CALL exner_hyb( ip1jmp1, ps, p, pks, pk)
    238         else
    239           call exner_milieu(ip1jmp1,ps,p,pks,pk)
    240         endif
    241         CALL massdair(p,masse)
    242 
    243247        ! bulk initialization of temperature
    244         teta(:,:)=tetarappel(:,:)
     248
     249        IF (iflag_phys>10000) THEN
     250        ! Particular case to impose a constant temperature T0=0.01*iflag_physx
     251           teta(:,:)= 0.01*iflag_phys/(pk(:,:)/cpp)
     252        ELSE
     253           teta(:,:)=tetarappel(:,:)
     254        ENDIF
    245255
    246256        ! geopotential
    247257        CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
     258
     259        DO l=1,llm
     260          print*,'presnivs,play,l',presnivs(l),(pk(1,l)/cpp)**(1./kappa)*preff
     261         !pks(ij) = (cpp/preff) * ps(ij)
     262         !pk(ij,1) = .5*pks(ij)
     263         ! pk = cpp * (p/preff)^kappa
     264        ENDDO
    248265
    249266        ! winds
    … …  
    292309        do l=1,llm
    293310           do ij=iip2,ip1jm
    294               teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
     311              teta(ij,l)=teta(ij,l)*(1.+tetanoise*ran1(idum))
    295312           enddo
    296313        enddo

  • LMDZ6/branches/Ocean_skin/libf/dyn3d/leapfrog.F

    r3416 r4013  
    748748
    749749              CLOSE(99)
     750              if (ok_guide) then
     751                ! set ok_guide to false to avoid extra output
     752                ! in following forward step
     753                ok_guide=.false.
     754              endif
    750755              !!! Ehouarn: Why not stop here and now?
    751756            ENDIF ! of IF (itau.EQ.itaufin)
    … …  
    868873     &                           vcov,ucov,teta,q,masse,ps)
    869874!                endif ! of if (planet_type.eq."earth")
     875                if (ok_guide) then
     876                  ! set ok_guide to false to avoid extra output
     877                  ! in following forward step
     878                  ok_guide=.false.
     879                endif
    870880              ENDIF ! of IF(itau.EQ.itaufin)
    871881

  • LMDZ6/branches/Ocean_skin/libf/dyn3d/vlsplt.F

    r2603 r4013  
    139139      END
    140140      RECURSIVE SUBROUTINE vlx(q,pente_max,masse,u_m,iq)
    141       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
     141      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi
     142     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
    142143
    143144c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    … …  
    456457          DO ij=iip2,ip1jm
    457458           ! On a besoin de q et masse seulement entre iip2 et ip1jm
    458            masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    459            Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     459           !masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
     460           !Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     461           !Mvals: veiller a ce qu'on n'ait pas de denominateur nul
     462           masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     463           if (q(ij,l,iq).gt.qperemin) then
     464             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     465           else
     466             Ratio(ij,l,iq2)=ratiomin
     467           endif
    460468          enddo   
    461469         enddo
    … …  
    473481      DO l=1,llm
    474482         DO ij=iip2+1,ip1jm
    475             new_m=masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l)
     483            !MVals: veiller a ce qu'on ait pas de denominateur nul
     484            new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),masseqmin)
    476485            q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+
    477486     &      u_mq(ij-1,l)-u_mq(ij,l))
    … …  
    489498      ! On calcule q entre iip2+1,ip1jm -> on fait pareil pour ratio
    490499      ! puis on boucle en longitude
    491       if (nqdesc(iq).gt.0) then 
     500      if (nqfils(iq).gt.0) then 
    492501       do ifils=1,nqdesc(iq)
    493502         iq2=iqfils(ifils,iq) 
    … …  
    510519      END
    511520      RECURSIVE SUBROUTINE vly(q,pente_max,masse,masse_adv_v,iq)
    512       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
     521      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi
     522     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
    513523c
    514524c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    … …  
    777787           ! attention, chaque fils doit avoir son masseq, sinon, le 1er
    778788           ! fils ecrase le masseq de ses freres.
    779            masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    780            Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)     
     789           !masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
     790           !Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)     
     791           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     792           masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     793           if (q(ij,l,iq).gt.qperemin) then
     794             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     795           else
     796             Ratio(ij,l,iq2)=ratiomin
     797           endif
    781798          enddo   
    782799         enddo
    … …  
    871888      END
    872889      RECURSIVE SUBROUTINE vlz(q,pente_max,masse,w,iq)
    873       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
     890      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi
     891     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
    874892c
    875893c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    … …  
    9971015         DO l=1,llm
    9981016          DO ij=1,ip1jmp1
    999            masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    1000            Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)       
     1017           !masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
     1018           !Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)       
     1019           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     1020           masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     1021           if (q(ij,l,iq).gt.qperemin) then
     1022             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     1023           else
     1024             Ratio(ij,l,iq2)=ratiomin
     1025           endif     
    10011026          enddo   
    10021027         enddo
Note: See TracChangeset for help on using the changeset viewer.