Changeset 3995


Ignore:
Timestamp:
Oct 29, 2021, 5:38:11 PM (3 years ago)
Author:
Ehouarn Millour
Message:

Nudging: fixed some indexes in parallel about process domain boundaries and updated the serial nudging routine so that it matches the parallel one (they had diverged at some point).
Also added an "is_master" logical in the parallel_lmdz module to ease decreasing the number of messages written to standard output.
EM

Location:
LMDZ6/trunk/libf
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3d/guide_mod.F90

    r3803 r3995  
    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/trunk/libf/dyn3dmem/guide_loc_mod.F90

    r3984 r3995  
    99!=======================================================================
    1010
    11   USE getparam
     11  USE getparam, only: ini_getparam, fin_getparam, getpar
    1212  USE Write_Field_loc
    1313  use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
    1414                    nf90_inq_dimid, nf90_inquire_dimension
    1515  USE parallel_lmdz
    16   USE pres2lev_mod
     16  USE pres2lev_mod, only: pres2lev
    1717
    1818  IMPLICIT NONE
    … …  
    6363  REAL, ALLOCATABLE, DIMENSION(:),   PRIVATE, SAVE   :: psgui1,psgui2
    6464 
    65   INTEGER,SAVE,PRIVATE :: ijbu,ijbv,ijeu,ijev,ijnu,ijnv
     65  INTEGER,SAVE,PRIVATE :: ijbu,ijbv,ijeu,ijev !,ijnu,ijnv
    6666  INTEGER,SAVE,PRIVATE :: jjbu,jjbv,jjeu,jjev,jjnu,jjnv
    6767
    … …  
    175175          rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl)
    176176          if (rcod.NE.NF_NOERR) THEN
    177              print *,'Guide: probleme -> pas de fichier apbp.nc'
     177             abort_message=' Nudging error -> no file apbp.nc'
    178178             CALL abort_gcm(modname,abort_message,1)
    179179          endif
    … …  
    183183          rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl)
    184184          if (rcod.NE.NF_NOERR) THEN
    185              print *,'Guide: probleme -> pas de fichier P.nc'
     185             abort_message=' Nudging error -> no file P.nc'
    186186             CALL abort_gcm(modname,abort_message,1)
    187187          endif
    … …  
    192192          rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
    193193          if (rcod.NE.NF_NOERR) THEN
    194              print *,'Guide: probleme -> pas de fichier u.nc'
     194             abort_message=' Nudging error -> no file u.nc'
    195195             CALL abort_gcm(modname,abort_message,1)
    196196          endif
    … …  
    203203          rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
    204204          if (rcod.NE.NF_NOERR) THEN
    205              print *,'Guide: probleme -> pas de fichier v.nc'
     205             abort_message=' Nudging error -> no file v.nc'
    206206             CALL abort_gcm(modname,abort_message,1)
    207207          endif
    … …  
    213213          rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
    214214          if (rcod.NE.NF_NOERR) THEN
    215              print *,'Guide: probleme -> pas de fichier T.nc'
     215             abort_message=' Nudging error -> no file T.nc'
    216216             CALL abort_gcm(modname,abort_message,1)
    217217          endif
    … …  
    224224          rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
    225225          if (rcod.NE.NF_NOERR) THEN
    226              print *,'Guide: probleme -> pas de fichier hur.nc'
     226             abort_message=' Nudging error -> no file hur.nc'
    227227             CALL abort_gcm(modname,abort_message,1)
    228228          endif
    … …  
    234234    IF (error.NE.NF_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid)
    235235    IF (error.NE.NF_NOERR) THEN
    236         print *,'Guide: probleme lecture niveaux pression'
     236        abort_message='Nudging: error reading pressure levels'
    237237        CALL abort_gcm(modname,abort_message,1)
    238238    ENDIF
    239239    error=NF_INQ_DIMLEN(ncidpl,rid,nlevnc)
    240     print *,'Guide: nombre niveaux vert. nlevnc', nlevnc
     240    write(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc
    241241    rcod = nf90_close(ncidpl)
    242242
    … …  
    244244! Allocation des variables
    245245! ---------------------------------------------
    246     abort_message='pb in allocation guide'
     246    abort_message='nudging allocation error'
    247247
    248248    ALLOCATE(apnc(nlevnc), stat = error)
    … …  
    395395   
    396396    INTEGER       :: i,j,l
    397     INTEGER,EXTERNAL :: OMP_GET_THREAD_NUM
     397    CHARACTER(LEN=20) :: modname="guide_main"
    398398       
    399399!$OMP MASTER   
    400     ijbu=ij_begin ; ijeu=ij_end ; ijnu=ijeu-ijbu+1 
     400    ijbu=ij_begin ; ijeu=ij_end
    401401    jjbu=jj_begin ; jjeu=jj_end ; jjnu=jjeu-jjbu+1
    402     ijbv=ij_begin ; ijev=ij_end ; ijnv=ijev-ijbv+1   
     402    ijbv=ij_begin ; ijev=ij_end
    403403    jjbv=jj_begin ; jjev=jj_end ; jjnv=jjev-jjbv+1
    404404    IF (pole_sud) THEN
     405      ijeu=ij_end-iip1
    405406      ijev=ij_end-iip1
    406407      jjev=jj_end-1
    407       ijnv=ijev-ijbv+1
    408408      jjnv=jjev-jjbv+1
     409    ENDIF
     410    IF (pole_nord) THEN
     411      ijbu=ij_begin+iip1
     412      ijbv=ij_begin
    409413    ENDIF
    410414!$OMP END MASTER
    … …  
    493497      IF (reste.EQ.0.) THEN
    494498          IF (itau_test.EQ.itau) THEN
    495               write(*,*)'deuxieme passage de advreel a itau=',itau
    496               stop
     499            write(*,*)trim(modname)//' second pass in advreel at itau=',&
     500            itau
     501            stop
    497502          ELSE
    498503!$OMP MASTER
    … …  
    507512              step_rea=step_rea+1
    508513              itau_test=itau
    509               print*,'Lecture fichiers guidage, pas ',step_rea, &
    510                     'apres ',count_no_rea,' non lectures'
     514              if (is_master) then
     515                write(*,*)trim(modname)//' Reading nudging files, step ',&
     516                    step_rea,'after ',count_no_rea,' skips'
     517              endif
    511518              IF (guide_2D) THEN
    512519!$OMP MASTER
    … …  
    547554   
    548555   
    549         !-----------------------------------------------------------------------
     556!-----------------------------------------------------------------------
    550557!   Ajout des champs de guidage
    551558!-----------------------------------------------------------------------
    … …  
    576583        ENDDO
    577584
    578 !!$OMP MASTER
    579 !     DO l=1,llm,5
    580 !         print*,'avant dump2d l=',l,mpi_rank,OMP_GET_THREAD_NUM()
    581 !         print*,'avant dump2d l=',l,mpi_rank
    582 !         CALL dump2d(iip1,jjnb_u,p(:,l),'ppp   ')
    583 !      ENDDO
    584 !!$OMP END MASTER
    585 !!$OMP BARRIER
    586 
    587585        CALL guide_out("SP",jjp1,llm,p(ijb_u:ije_u,1:llm),1.)
    588586    ENDIF
    … …  
    605603        if (guide_zon) CALL guide_zonave_u(1,llm,f_addu)
    606604        CALL guide_addfield_u(llm,f_addu,alpha_u)
    607 !       IF (f_out) CALL guide_out("ua",jjp1,llm,ugui1(ijb_u:ije_u,:),factt)
    608605        IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)*ugui1(ijb_u:ije_u,:)+tau*ugui2(ijb_u:ije_u,:),factt)
    609606        IF (f_out) CALL guide_out("u",jjp1,llm,ucov(ijb_u:ije_u,:),factt)
    610         IF (f_out) CALL guide_out("ucov",jjp1,llm,f_addu(ijb_u:ije_u,:)/factt,factt)
     607        IF (f_out) THEN
     608         ! Ehouarn: fill the gaps adequately...
     609         IF (ijbu>ijb_u) f_addu(ijb_u:ijbu-1,:)=0
     610         IF (ijeu<ije_u) f_addu(ijeu+1:ije_u,:)=0
     611         CALL guide_out("ucov",jjp1,llm,f_addu(ijb_u:ije_u,:)/factt,factt)
     612        ENDIF
    611613!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    612614        DO l=1,llm
    … …  
    703705        IF (f_out) CALL guide_out("v",jjm,llm,vcov(ijb_v:ije_v,:),factt)
    704706        IF (f_out) CALL guide_out("va",jjm,llm,(1.-tau)*vgui1(ijb_v:ije_v,:)+tau*vgui2(ijb_v:ije_v,:),factt)
    705         IF (f_out) CALL guide_out("vcov",jjm,llm,f_addv(:,:)/factt,factt)
     707        IF (f_out) THEN
     708          ! Ehouarn: Fill in the gaps adequately
     709          IF (ijbv>ijb_v) f_addv(ijb_v:ijbv-1,:)=0
     710          IF (ijev<ije_v) f_addv(ijev+1:ije_v,:)=0
     711          CALL guide_out("vcov",jjm,llm,f_addv(ijb_v:ije_v,:)/factt,factt)
     712        ENDIF
    706713
    707714!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    … …  
    939946 
    940947  INTEGER                            :: i,j,l,ij
     948  CHARACTER(LEN=20),PARAMETER :: modname="guide_interp"
    941949  TYPE(Request),SAVE :: Req 
    942950!$OMP THREADPRIVATE(Req)
    943     print *,'Guide: conversion variables guidage'
     951   
     952    if (is_master) write(*,*)trim(modname)//': interpolate nudging variables'
    944953! -----------------------------------------------------------------
    945954! Calcul des niveaux de pression champs guidage (pour T et Q)
    … …  
    986995        first=.FALSE.
    987996!$OMP MASTER
    988         print*,'Guide: verification ordre niveaux verticaux'
    989         print*,'LMDZ :'
     997        write(*,*)trim(modname)//' : check vertical level order'
     998        write(*,*)trim(modname)//' LMDZ :'
    990999        do l=1,llm
    991             print*,'PL(',l,')=',(ap(l)+ap(l+1))/2. &
     1000          write(*,*)trim(modname)//' PL(',l,')=',(ap(l)+ap(l+1))/2. &
    9921001                  +psi(1,jjeu)*(bp(l)+bp(l+1))/2.
    9931002        enddo
    994         print*,'Fichiers guidage'
     1003        write(*,*)trim(modname)//' nudging file :'
    9951004        SELECT CASE (guide_plevs)
    9961005        CASE (0)
    9971006            do l=1,nlevnc
    998                  print*,'PL(',l,')=',plnc2(1,jjbu,l)
     1007              write(*,*)trim(modname)//' PL(',l,')=',plnc2(1,jjbu,l)
    9991008            enddo
    10001009        CASE (1)
    10011010            DO l=1,nlevnc
    1002                  print*,'PL(',l,')=',apnc(l)+bpnc(l)*psnat2(i,jjbu)
    1003              ENDDO
     1011              write(*,*)trim(modname)//' PL(',l,')=',&
     1012                        apnc(l)+bpnc(l)*psnat2(i,jjbu)
     1013            ENDDO
    10041014        CASE (2)
    10051015            do l=1,nlevnc
    1006                  print*,'PL(',l,')=',pnat2(1,jjbu,l)
     1016              write(*,*)trim(modname)//' PL(',l,')=',pnat2(1,jjbu,l)
    10071017            enddo
    10081018        END SELECT
    1009         print *,'inversion de l''ordre: invert_p=',invert_p
     1019        write(*,*)trim(modname)//' invert ordering: invert_p=',invert_p
    10101020        if (guide_u) then
    10111021            do l=1,nlevnc
    1012                 print*,'U(',l,')=',unat2(1,jjbu,l)
     1022              write(*,*)trim(modname)//' U(',l,')=',unat2(1,jjbu,l)
    10131023            enddo
    10141024        endif
    10151025        if (guide_T) then
    10161026            do l=1,nlevnc
    1017                 print*,'T(',l,')=',tnat2(1,jjbu,l)
     1027              write(*,*)trim(modname)//' T(',l,')=',tnat2(1,jjbu,l)
    10181028            enddo
    10191029        endif
    10201030!$OMP END MASTER
    1021     endif
     1031    endif ! of if (first)
    10221032   
    10231033! -----------------------------------------------------------------
    … …  
    14151425    real alphamin,alphamax,xi
    14161426    integer i,j,ilon,ilat
     1427    character(len=20),parameter :: modname="tau2alpha"
    14171428
    14181429
    … …  
    15031514            ! Calcul de gamma
    15041515            if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then
    1505                  print*,'ATTENTION modele peu zoome'
    1506                  print*,'ATTENTION on prend une constante de guidage cste'
    1507                  gamma=0.
     1516              write(*,*)trim(modname)//' ATTENTION modele peu zoome'
     1517              write(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste'
     1518              gamma=0.
    15081519            else
    1509                 gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
    1510                 print*,'gamma=',gamma
    1511                 if (gamma.lt.1.e-5) then
    1512                   print*,'gamma =',gamma,'<1e-5'
    1513                   stop
    1514                 endif
    1515                 gamma=log(0.5)/log(gamma)
    1516                 if (gamma4) then
    1517                   gamma=min(gamma,4.)
    1518                 endif
    1519                 print*,'gamma=',gamma
     1520              gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
     1521              write(*,*)trim(modname)//' gamma=',gamma
     1522              if (gamma.lt.1.e-5) then
     1523                write(*,*)trim(modname)//' gamma =',gamma,'<1e-5'
     1524                stop
     1525              endif
     1526              gamma=log(0.5)/log(gamma)
     1527              if (gamma4) then
     1528                gamma=min(gamma,4.)
     1529              endif
     1530              write(*,*)trim(modname)//' gamma=',gamma
    15201531            endif
    15211532        ENDIF !first
    … …  
    15581569    IMPLICIT NONE
    15591570
    1560 #include "netcdf.inc"
    1561 #include "dimensions.h"
    1562 #include "paramet.h"
     1571    include "netcdf.inc"
     1572    include "dimensions.h"
     1573    include "paramet.h"
    15631574
    15641575    INTEGER, INTENT(IN)   :: timestep
    … …  
    15821593    if (first) then
    15831594         ncidpl=-99
    1584          print*,'Guide: ouverture des fichiers guidage '
     1595         write(*,*),trim(modname)//': opening nudging files '
    15851596! Ap et Bp si Niveaux de pression hybrides
    15861597         if (guide_plevs.EQ.1) then
    1587              print *,'Lecture du guidage sur niveaux modele'
     1598             write(*,*),trim(modname)//' Reading nudging on model levels'
    15881599             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    15891600             IF (rcode.NE.NF_NOERR) THEN
    1590               print *,'Guide: probleme -> pas de fichier apbp.nc'
     1601              abort_message='Nudging: error -> no file apbp.nc'
    15911602              CALL abort_gcm(modname,abort_message,1)
    15921603             ENDIF
    15931604             rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
    15941605             IF (rcode.NE.NF_NOERR) THEN
    1595               print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc'
     1606              abort_message='Nudging: error -> no AP variable in file apbp.nc'
    15961607              CALL abort_gcm(modname,abort_message,1)
    15971608             ENDIF
    15981609             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    15991610             IF (rcode.NE.NF_NOERR) THEN
    1600               print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc'
     1611              abort_message='Nudging: error -> no BP variable in file apbp.nc'
    16011612              CALL abort_gcm(modname,abort_message,1)
    16021613             ENDIF
    1603              print*,'ncidpl,varidap',ncidpl,varidap
     1614             write(*,*),trim(modname)//' ncidpl,varidap',ncidpl,varidap
    16041615         endif
    16051616         
    … …  
    16081619             rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
    16091620             IF (rcode.NE.NF_NOERR) THEN
    1610               print *,'Guide: probleme -> pas de fichier P.nc'
     1621              abort_message='Nudging: error -> no file P.nc'
    16111622              CALL abort_gcm(modname,abort_message,1)
    16121623             ENDIF
    16131624             rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
    16141625             IF (rcode.NE.NF_NOERR) THEN
    1615               print *,'Guide: probleme -> pas de variable PRES, fichier P.nc'
     1626              abort_message='Nudging: error -> no PRES variable in file P.nc'
    16161627              CALL abort_gcm(modname,abort_message,1)
    16171628             ENDIF
    1618              print*,'ncidp,varidp',ncidp,varidp
     1629             write(*,*),trim(modname)//' ncidp,varidp',ncidp,varidp
    16191630             if (ncidpl.eq.-99) ncidpl=ncidp
    16201631         endif
    … …  
    16241635             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    16251636             IF (rcode.NE.NF_NOERR) THEN
    1626               print *,'Guide: probleme -> pas de fichier u.nc'
     1637              abort_message='Nudging: error -> no file u.nc'
    16271638              CALL abort_gcm(modname,abort_message,1)
    16281639             ENDIF
    16291640             rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
    16301641             IF (rcode.NE.NF_NOERR) THEN
    1631               print *,'Guide: probleme -> pas de variable UWND, fichier u.nc'
     1642              abort_message='Nudging: error -> no UWND variable in file u.nc'
    16321643              CALL abort_gcm(modname,abort_message,1)
    16331644             ENDIF
    1634              print*,'ncidu,varidu',ncidu,varidu
     1645             write(*,*),trim(modname)//' ncidu,varidu',ncidu,varidu
    16351646             if (ncidpl.eq.-99) ncidpl=ncidu
    16361647
    … …  
    16391650             status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim)
    16401651             IF (lendim .NE. iip1) THEN
    1641                 print *,'dimension LONU different from iip1 in u.nc'
     1652                abort_message='dimension LONU different from iip1 in u.nc'
    16421653                CALL abort_gcm(modname,abort_message,1)
    16431654             ENDIF
    … …  
    16461657             status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim)
    16471658             IF (lendim .NE. jjp1) THEN
    1648                 print *,'dimension LATU different from jjp1 in u.nc'
     1659                abort_message='dimension LATU different from jjp1 in u.nc'
    16491660                CALL abort_gcm(modname,abort_message,1)
    16501661             ENDIF
    … …  
    16561667             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    16571668             IF (rcode.NE.NF_NOERR) THEN
    1658               print *,'Guide: probleme -> pas de fichier v.nc'
     1669              abort_message='Nudging: error -> no file v.nc'
    16591670              CALL abort_gcm(modname,abort_message,1)
    16601671             ENDIF
    16611672             rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    16621673             IF (rcode.NE.NF_NOERR) THEN
    1663               print *,'Guide: probleme -> pas de variable VWND, fichier v.nc'
     1674              abort_message='Nudging: error -> no VWND variable in file v.nc'
    16641675              CALL abort_gcm(modname,abort_message,1)
    16651676             ENDIF
    1666              print*,'ncidv,varidv',ncidv,varidv
     1677             write(*,*),trim(modname)//' ncidv,varidv',ncidv,varidv
    16671678             if (ncidpl.eq.-99) ncidpl=ncidv
    16681679             
    … …  
    16711682             
    16721683                IF (lendim .NE. iip1) THEN
    1673                 print *,'dimension LONV different from iip1 in v.nc'
     1684                abort_message='dimension LONV different from iip1 in v.nc'
    16741685                CALL abort_gcm(modname,abort_message,1)
    16751686             ENDIF
    … …  
    16791690             status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim)
    16801691             IF (lendim .NE. jjm) THEN
    1681                 print *,'dimension LATV different from jjm in v.nc'
     1692                abort_message='dimension LATV different from jjm in v.nc'
    16821693                CALL abort_gcm(modname,abort_message,1)
    16831694             ENDIF
    … …  
    16891700             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    16901701             IF (rcode.NE.NF_NOERR) THEN
    1691               print *,'Guide: probleme -> pas de fichier T.nc'
     1702              abort_message='Nudging: error -> no file T.nc'
    16921703              CALL abort_gcm(modname,abort_message,1)
    16931704             ENDIF
    16941705             rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    16951706             IF (rcode.NE.NF_NOERR) THEN
    1696               print *,'Guide: probleme -> pas de variable AIR, fichier T.nc'
     1707              abort_message='Nudging: error -> no AIR variable in file T.nc'
    16971708              CALL abort_gcm(modname,abort_message,1)
    16981709             ENDIF
    1699              print*,'ncidT,varidT',ncidt,varidt
     1710             write(*,*),trim(modname)//' ncidT,varidT',ncidt,varidt
    17001711             if (ncidpl.eq.-99) ncidpl=ncidt
    17011712
    … …  
    17031714             status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim)
    17041715             IF (lendim .NE. iip1) THEN
    1705                 print *,'dimension LONV different from iip1 in T.nc'
     1716                abort_message='dimension LONV different from iip1 in T.nc'
    17061717                CALL abort_gcm(modname,abort_message,1)
    17071718             ENDIF
    … …  
    17101721             status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim)
    17111722             IF (lendim .NE. jjp1) THEN
    1712                 print *,'dimension LATU different from jjp1 in T.nc'
     1723                abort_message='dimension LATU different from jjp1 in T.nc'
    17131724                CALL abort_gcm(modname,abort_message,1)
    17141725             ENDIF
    … …  
    17201731             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    17211732             IF (rcode.NE.NF_NOERR) THEN
    1722               print *,'Guide: probleme -> pas de fichier hur.nc'
     1733              abort_message='Nudging: error -> no file hur.nc'
    17231734              CALL abort_gcm(modname,abort_message,1)
    17241735             ENDIF
    17251736             rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    17261737             IF (rcode.NE.NF_NOERR) THEN
    1727               print *,'Guide: probleme -> pas de variable RH, fichier hur.nc'
     1738              abort_message='Nudging: error -> no RH variable in file hur.nc'
    17281739              CALL abort_gcm(modname,abort_message,1)
    17291740             ENDIF
    1730              print*,'ncidQ,varidQ',ncidQ,varidQ
     1741             write(*,*),trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
    17311742             if (ncidpl.eq.-99) ncidpl=ncidQ
    17321743
    … …  
    17351746             status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim)
    17361747             IF (lendim .NE. iip1) THEN
    1737                 print *,'dimension LONV different from iip1 in hur.nc'
     1748                abort_message='dimension LONV different from iip1 in hur.nc'
    17381749                CALL abort_gcm(modname,abort_message,1)
    17391750             ENDIF
    … …  
    17421753             status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim)
    17431754             IF (lendim .NE. jjp1) THEN
    1744                 print *,'dimension LATU different from jjp1 in hur.nc'
     1755                abort_message='dimension LATU different from jjp1 in hur.nc'
    17451756                CALL abort_gcm(modname,abort_message,1)
    17461757             ENDIF
    … …  
    17521763             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    17531764             IF (rcode.NE.NF_NOERR) THEN
    1754               print *,'Guide: probleme -> pas de fichier ps.nc'
     1765              abort_message='Nudging: error -> no file ps.nc'
    17551766              CALL abort_gcm(modname,abort_message,1)
    17561767             ENDIF
    17571768             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    17581769             IF (rcode.NE.NF_NOERR) THEN
    1759               print *,'Guide: probleme -> pas de variable SP, fichier ps.nc'
     1770              abort_message='Nudging: error -> no SP variable in file ps.nc'
    17601771              CALL abort_gcm(modname,abort_message,1)
    17611772             ENDIF
    1762              print*,'ncidps,varidps',ncidps,varidps
     1773             write(*,*),trim(modname)//' ncidps,varidps',ncidps,varidps
    17631774         endif
    17641775! Coordonnee verticale
    … …  
    17661777              rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    17671778              IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    1768               print*,'ncidpl,varidpl',ncidpl,varidpl
     1779              write(*,*),trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
    17691780         endif
    17701781! Coefs ap, bp pour calcul de la pression aux differents niveaux
    … …  
    19111922    IMPLICIT NONE
    19121923
    1913 #include "netcdf.inc"
    1914 #include "dimensions.h"
    1915 #include "paramet.h"
     1924    include "netcdf.inc"
     1925    include "dimensions.h"
     1926    include "paramet.h"
    19161927
    19171928    INTEGER, INTENT(IN)   :: timestep
    … …  
    19381949    if (first) then
    19391950         ncidpl=-99
    1940          print*,'Guide: ouverture des fichiers guidage '
     1951         write(*,*)trim(modname)//' : opening nudging files '
    19411952! Ap et Bp si niveaux de pression hybrides
    19421953         if (guide_plevs.EQ.1) then
    1943              print *,'Lecture du guidage sur niveaux mod�le'
    1944              rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    1945              IF (rcode.NE.NF_NOERR) THEN
    1946               print *,'Guide: probleme -> pas de fichier apbp.nc'
    1947               CALL abort_gcm(modname,abort_message,1)
    1948              ENDIF
    1949              rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
    1950              IF (rcode.NE.NF_NOERR) THEN
    1951               print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc'
    1952               CALL abort_gcm(modname,abort_message,1)
    1953              ENDIF
    1954              rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    1955              IF (rcode.NE.NF_NOERR) THEN
    1956               print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc'
    1957               CALL abort_gcm(modname,abort_message,1)
    1958              ENDIF
    1959              print*,'ncidpl,varidap',ncidpl,varidap
     1954           write(*,*)trim(modname)//' Reading nudging on model levels'
     1955           rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
     1956           IF (rcode.NE.NF_NOERR) THEN
     1957             abort_message='Nudging: error -> no file apbp.nc'
     1958           CALL abort_gcm(modname,abort_message,1)
     1959           ENDIF
     1960           rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
     1961           IF (rcode.NE.NF_NOERR) THEN
     1962             abort_message='Nudging: error -> no AP variable in file apbp.nc'
     1963           CALL abort_gcm(modname,abort_message,1)
     1964           ENDIF
     1965           rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
     1966           IF (rcode.NE.NF_NOERR) THEN
     1967             abort_message='Nudging: error -> no BP variable in file apbp.nc'
     1968             CALL abort_gcm(modname,abort_message,1)
     1969           ENDIF
     1970           write(*,*)trim(modname)//'ncidpl,varidap',ncidpl,varidap
    19601971         endif
    19611972! Pression
    19621973         if (guide_plevs.EQ.2) then
    1963              rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
    1964              IF (rcode.NE.NF_NOERR) THEN
    1965               print *,'Guide: probleme -> pas de fichier P.nc'
    1966               CALL abort_gcm(modname,abort_message,1)
    1967              ENDIF
    1968              rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
    1969              IF (rcode.NE.NF_NOERR) THEN
    1970               print *,'Guide: probleme -> pas de variable PRES, fichier P.nc'
    1971               CALL abort_gcm(modname,abort_message,1)
    1972              ENDIF
    1973              print*,'ncidp,varidp',ncidp,varidp
    1974              if (ncidpl.eq.-99) ncidpl=ncidp
     1974           rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
     1975           IF (rcode.NE.NF_NOERR) THEN
     1976             abort_message='Nudging: error -> no file P.nc'
     1977             CALL abort_gcm(modname,abort_message,1)
     1978           ENDIF
     1979           rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
     1980           IF (rcode.NE.NF_NOERR) THEN
     1981             abort_message='Nudging: error -> no PRES variable in file P.nc'
     1982             CALL abort_gcm(modname,abort_message,1)
     1983           ENDIF
     1984           write(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp
     1985           if (ncidpl.eq.-99) ncidpl=ncidp
    19751986         endif
    19761987! Vent zonal
    19771988         if (guide_u) then
    1978              rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    1979              IF (rcode.NE.NF_NOERR) THEN
    1980               print *,'Guide: probleme -> pas de fichier u.nc'
    1981               CALL abort_gcm(modname,abort_message,1)
    1982              ENDIF
    1983              rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
    1984              IF (rcode.NE.NF_NOERR) THEN
    1985               print *,'Guide: probleme -> pas de variable UWND, fichier u.nc'
    1986               CALL abort_gcm(modname,abort_message,1)
    1987              ENDIF
    1988              print*,'ncidu,varidu',ncidu,varidu
    1989              if (ncidpl.eq.-99) ncidpl=ncidu
     1989           rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
     1990           IF (rcode.NE.NF_NOERR) THEN
     1991             abort_message='Nudging: error -> no file u.nc'
     1992             CALL abort_gcm(modname,abort_message,1)
     1993           ENDIF
     1994           rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
     1995           IF (rcode.NE.NF_NOERR) THEN
     1996             abort_message='Nudging: error -> no UWND variable in file u.nc'
     1997             CALL abort_gcm(modname,abort_message,1)
     1998           ENDIF
     1999           write(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu
     2000           if (ncidpl.eq.-99) ncidpl=ncidu
    19902001         endif
    19912002
    19922003! Vent meridien
    19932004         if (guide_v) then
    1994              rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    1995              IF (rcode.NE.NF_NOERR) THEN
    1996               print *,'Guide: probleme -> pas de fichier v.nc'
    1997               CALL abort_gcm(modname,abort_message,1)
    1998              ENDIF
    1999              rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    2000              IF (rcode.NE.NF_NOERR) THEN
    2001               print *,'Guide: probleme -> pas de variable VWND, fichier v.nc'
    2002               CALL abort_gcm(modname,abort_message,1)
    2003              ENDIF
    2004              print*,'ncidv,varidv',ncidv,varidv
    2005              if (ncidpl.eq.-99) ncidpl=ncidv
    2006          endif
     2005           rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
     2006           IF (rcode.NE.NF_NOERR) THEN
     2007             abort_message='Nudging: error -> no file v.nc'
     2008             CALL abort_gcm(modname,abort_message,1)
     2009           ENDIF
     2010           rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
     2011           IF (rcode.NE.NF_NOERR) THEN
     2012             abort_message='Nudging: error -> no VWND variable in file v.nc'
     2013             CALL abort_gcm(modname,abort_message,1)
     2014           ENDIF
     2015           write(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv
     2016           if (ncidpl.eq.-99) ncidpl=ncidv
     2017        endif
    20072018! Temperature
    20082019         if (guide_T) then
    2009              rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    2010              IF (rcode.NE.NF_NOERR) THEN
    2011               print *,'Guide: probleme -> pas de fichier T.nc'
    2012               CALL abort_gcm(modname,abort_message,1)
    2013              ENDIF
    2014              rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    2015              IF (rcode.NE.NF_NOERR) THEN
    2016               print *,'Guide: probleme -> pas de variable AIR, fichier T.nc'
    2017               CALL abort_gcm(modname,abort_message,1)
    2018              ENDIF
    2019              print*,'ncidT,varidT',ncidt,varidt
    2020              if (ncidpl.eq.-99) ncidpl=ncidt
     2020           rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
     2021           IF (rcode.NE.NF_NOERR) THEN
     2022             abort_message='Nudging: error -> no file T.nc'
     2023             CALL abort_gcm(modname,abort_message,1)
     2024           ENDIF
     2025           rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
     2026           IF (rcode.NE.NF_NOERR) THEN
     2027             abort_message='Nudging: error -> no AIR variable in file T.nc'
     2028             CALL abort_gcm(modname,abort_message,1)
     2029           ENDIF
     2030           write(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt
     2031           if (ncidpl.eq.-99) ncidpl=ncidt
    20212032         endif
    20222033! Humidite
    20232034         if (guide_Q) then
    2024              rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    2025              IF (rcode.NE.NF_NOERR) THEN
    2026               print *,'Guide: probleme -> pas de fichier hur.nc'
    2027               CALL abort_gcm(modname,abort_message,1)
    2028              ENDIF
    2029              rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    2030              IF (rcode.NE.NF_NOERR) THEN
    2031               print *,'Guide: probleme -> pas de variable RH, fichier hur.nc'
    2032               CALL abort_gcm(modname,abort_message,1)
    2033              ENDIF
    2034              print*,'ncidQ,varidQ',ncidQ,varidQ
    2035              if (ncidpl.eq.-99) ncidpl=ncidQ
     2035           rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
     2036           IF (rcode.NE.NF_NOERR) THEN
     2037             abort_message='Nudging: error -> no file hur.nc'
     2038             CALL abort_gcm(modname,abort_message,1)
     2039           ENDIF
     2040           rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
     2041           IF (rcode.NE.NF_NOERR) THEN
     2042             abort_message='Nudging: error -> no RH,variable in file hur.nc'
     2043             CALL abort_gcm(modname,abort_message,1)
     2044           ENDIF
     2045           write(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
     2046           if (ncidpl.eq.-99) ncidpl=ncidQ
    20362047         endif
    20372048! Pression de surface
    20382049         if ((guide_P).OR.(guide_plevs.EQ.1)) then
    2039              rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    2040              IF (rcode.NE.NF_NOERR) THEN
    2041               print *,'Guide: probleme -> pas de fichier ps.nc'
    2042               CALL abort_gcm(modname,abort_message,1)
    2043              ENDIF
    2044              rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    2045              IF (rcode.NE.NF_NOERR) THEN
    2046               print *,'Guide: probleme -> pas de variable SP, fichier ps.nc'
    2047               CALL abort_gcm(modname,abort_message,1)
    2048              ENDIF
    2049              print*,'ncidps,varidps',ncidps,varidps
     2050           rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
     2051           IF (rcode.NE.NF_NOERR) THEN
     2052             abort_message='Nudging: error -> no file ps.nc'
     2053             CALL abort_gcm(modname,abort_message,1)
     2054           ENDIF
     2055           rcode = nf90_inq_varid(ncidps, 'SP', varidps)
     2056           IF (rcode.NE.NF_NOERR) THEN
     2057             abort_message='Nudging: error -> no SP variable in file ps.nc'
     2058             CALL abort_gcm(modname,abort_message,1)
     2059           ENDIF
     2060           write(*,*)trim(modname)//' ncidps,varidps',ncidps,varidps
    20502061         endif
    20512062! Coordonnee verticale
    20522063         if (guide_plevs.EQ.0) then
    2053               rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    2054               IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    2055               print*,'ncidpl,varidpl',ncidpl,varidpl
     2064           rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
     2065           IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
     2066           write(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
    20562067         endif
    20572068! Coefs ap, bp pour calcul de la pression aux differents niveaux
    … …  
    22472258    REAL zu(ip1jmp1),zv(ip1jm), zt(iip1, jjp1), zq(iip1, jjp1)
    22482259    REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: field_glo
     2260    CHARACTER(LEN=20),PARAMETER :: modname="guide_out"
    22492261   
    22502262!$OMP MASTER
    … …  
    22532265!$OMP BARRIER
    22542266
    2255     print*,'gvide_out apres allocation ',hsize,vsize
     2267!    write(*,*)trim(modname)//' after allocation ',hsize,vsize
    22562268
    22572269    IF (hsize==jjp1) THEN
    … …  
    22612273    ENDIF
    22622274
    2263     print*,'guide_out apres gather '
     2275!    write(*,*)trim(modname)//' after gather '
    22642276    CALL Gather_field_u(alpha_u,zu,1)
    22652277    CALL Gather_field_u(alpha_t,zt,1)
    … …  
    24312443!$OMP BARRIER
    24322444
    2433     RETURN
    2434 
    24352445  END SUBROUTINE guide_out
    24362446   

  • LMDZ6/trunk/libf/dyn3dmem/parallel_lmdz.F90

    r2771 r3995  
    1212    INTEGER,PARAMETER :: halo_max=3
    1313   
    14     LOGICAL,SAVE :: using_mpi
    15     LOGICAL,SAVE :: using_omp
     14    LOGICAL,SAVE :: using_mpi ! .true. if using MPI
     15    LOGICAL,SAVE :: using_omp ! .true. if using OpenMP
     16    LOGICAL,SAVE :: is_master ! .true. if the core is both MPI & OpenMP master
     17!$OMP THREADPRIVATE(is_master)
    1618   
    1719    integer, save :: mpi_size
    … …  
    248250!$OMP END PARALLEL         
    249251      CALL create_distrib(jj_nb_para,current_dist)
     252     
     253      IF ((mpi_rank==0).and.(omp_rank==0)) THEN
     254        is_master=.true.
     255      ELSE
     256        is_master=.false.
     257      ENDIF
    250258     
    251259    end subroutine init_parallel
Note: See TracChangeset for help on using the changeset viewer.