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

Sync latest trunk changes to Ocean_skin

Location:
LMDZ6/branches/Ocean_skin
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Ocean_skin

  • LMDZ6/branches/Ocean_skin/libf/dyn3dmem/guide_loc_mod.F90

    r3811 r4013  
    99!=======================================================================
    1010
    11   USE getparam
     11  USE getparam, only: ini_getparam, fin_getparam, getpar
    1212  USE Write_Field_loc
    13   use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close
     13  use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
     14                    nf90_inq_dimid, nf90_inquire_dimension
    1415  USE parallel_lmdz
    15   USE pres2lev_mod
     16  USE pres2lev_mod, only: pres2lev
    1617
    1718  IMPLICIT NONE
    … …  
    6263  REAL, ALLOCATABLE, DIMENSION(:),   PRIVATE, SAVE   :: psgui1,psgui2
    6364 
    64   INTEGER,SAVE,PRIVATE :: ijbu,ijbv,ijeu,ijev,ijnu,ijnv
     65  INTEGER,SAVE,PRIVATE :: ijbu,ijbv,ijeu,ijev !,ijnu,ijnv
    6566  INTEGER,SAVE,PRIVATE :: jjbu,jjbv,jjeu,jjev,jjnu,jjnv
    6667
    … …  
    8384    CHARACTER (len = 80)   :: abort_message
    8485    CHARACTER (len = 20)   :: modname = 'guide_init'
     86    CHARACTER (len = 20)   :: namedim
    8587
    8688! ---------------------------------------------
    … …  
    173175          rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl)
    174176          if (rcod.NE.NF_NOERR) THEN
    175              print *,'Guide: probleme -> pas de fichier apbp.nc'
     177             abort_message=' Nudging error -> no file apbp.nc'
    176178             CALL abort_gcm(modname,abort_message,1)
    177179          endif
    … …  
    181183          rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl)
    182184          if (rcod.NE.NF_NOERR) THEN
    183              print *,'Guide: probleme -> pas de fichier P.nc'
     185             abort_message=' Nudging error -> no file P.nc'
    184186             CALL abort_gcm(modname,abort_message,1)
    185187          endif
    186188       endif
     189
    187190    elseif (guide_u) then
    188191       if (ncidpl.eq.-99) then
    189192          rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
    190193          if (rcod.NE.NF_NOERR) THEN
    191              print *,'Guide: probleme -> pas de fichier u.nc'
     194             abort_message=' Nudging error -> no file u.nc'
    192195             CALL abort_gcm(modname,abort_message,1)
    193196          endif
     197         
    194198       endif
     199
     200
    195201    elseif (guide_v) then
    196202       if (ncidpl.eq.-99) then
    197203          rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
    198204          if (rcod.NE.NF_NOERR) THEN
    199              print *,'Guide: probleme -> pas de fichier v.nc'
     205             abort_message=' Nudging error -> no file v.nc'
    200206             CALL abort_gcm(modname,abort_message,1)
    201207          endif
    202208       endif
     209
     210   
    203211    elseif (guide_T) then
    204212       if (ncidpl.eq.-99) then
    205213          rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
    206214          if (rcod.NE.NF_NOERR) THEN
    207              print *,'Guide: probleme -> pas de fichier T.nc'
     215             abort_message=' Nudging error -> no file T.nc'
    208216             CALL abort_gcm(modname,abort_message,1)
    209217          endif
    210218       endif
     219
     220
     221
    211222    elseif (guide_Q) then
    212223       if (ncidpl.eq.-99) then
    213224          rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
    214225          if (rcod.NE.NF_NOERR) THEN
    215              print *,'Guide: probleme -> pas de fichier hur.nc'
     226             abort_message=' Nudging error -> no file hur.nc'
    216227             CALL abort_gcm(modname,abort_message,1)
    217228          endif
    218229       endif
     230
     231
    219232    endif
    220233    error=NF_INQ_DIMID(ncidpl,'LEVEL',rid)
    221234    IF (error.NE.NF_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid)
    222235    IF (error.NE.NF_NOERR) THEN
    223         print *,'Guide: probleme lecture niveaux pression'
     236        abort_message='Nudging: error reading pressure levels'
    224237        CALL abort_gcm(modname,abort_message,1)
    225238    ENDIF
    226239    error=NF_INQ_DIMLEN(ncidpl,rid,nlevnc)
    227     print *,'Guide: nombre niveaux vert. nlevnc', nlevnc
     240    write(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc
    228241    rcod = nf90_close(ncidpl)
    229242
    … …  
    231244! Allocation des variables
    232245! ---------------------------------------------
    233     abort_message='pb in allocation guide'
     246    abort_message='nudging allocation error'
    234247
    235248    ALLOCATE(apnc(nlevnc), stat = error)
    … …  
    382395   
    383396    INTEGER       :: i,j,l
    384     INTEGER,EXTERNAL :: OMP_GET_THREAD_NUM
     397    CHARACTER(LEN=20) :: modname="guide_main"
    385398       
    386399!$OMP MASTER   
    387     ijbu=ij_begin ; ijeu=ij_end ; ijnu=ijeu-ijbu+1 
     400    ijbu=ij_begin ; ijeu=ij_end
    388401    jjbu=jj_begin ; jjeu=jj_end ; jjnu=jjeu-jjbu+1
    389     ijbv=ij_begin ; ijev=ij_end ; ijnv=ijev-ijbv+1   
     402    ijbv=ij_begin ; ijev=ij_end
    390403    jjbv=jj_begin ; jjev=jj_end ; jjnv=jjev-jjbv+1
    391404    IF (pole_sud) THEN
     405      ijeu=ij_end-iip1
    392406      ijev=ij_end-iip1
    393407      jjev=jj_end-1
    394       ijnv=ijev-ijbv+1
    395408      jjnv=jjev-jjbv+1
     409    ENDIF
     410    IF (pole_nord) THEN
     411      ijbu=ij_begin+iip1
     412      ijbv=ij_begin
    396413    ENDIF
    397414!$OMP END MASTER
    … …  
    480497      IF (reste.EQ.0.) THEN
    481498          IF (itau_test.EQ.itau) THEN
    482               write(*,*)'deuxieme passage de advreel a itau=',itau
    483               stop
     499            write(*,*)trim(modname)//' second pass in advreel at itau=',&
     500            itau
     501            stop
    484502          ELSE
    485503!$OMP MASTER
    … …  
    494512              step_rea=step_rea+1
    495513              itau_test=itau
    496               print*,'Lecture fichiers guidage, pas ',step_rea, &
    497                     '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
    498518              IF (guide_2D) THEN
    499519!$OMP MASTER
    … …  
    534554   
    535555   
    536         !-----------------------------------------------------------------------
     556!-----------------------------------------------------------------------
    537557!   Ajout des champs de guidage
    538558!-----------------------------------------------------------------------
    … …  
    563583        ENDDO
    564584
    565 !!$OMP MASTER
    566 !     DO l=1,llm,5
    567 !         print*,'avant dump2d l=',l,mpi_rank,OMP_GET_THREAD_NUM()
    568 !         print*,'avant dump2d l=',l,mpi_rank
    569 !         CALL dump2d(iip1,jjnb_u,p(:,l),'ppp   ')
    570 !      ENDDO
    571 !!$OMP END MASTER
    572 !!$OMP BARRIER
    573 
    574585        CALL guide_out("SP",jjp1,llm,p(ijb_u:ije_u,1:llm),1.)
    575586    ENDIF
    … …  
    592603        if (guide_zon) CALL guide_zonave_u(1,llm,f_addu)
    593604        CALL guide_addfield_u(llm,f_addu,alpha_u)
    594 !       IF (f_out) CALL guide_out("ua",jjp1,llm,ugui1(ijb_u:ije_u,:),factt)
    595605        IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)*ugui1(ijb_u:ije_u,:)+tau*ugui2(ijb_u:ije_u,:),factt)
    596606        IF (f_out) CALL guide_out("u",jjp1,llm,ucov(ijb_u:ije_u,:),factt)
    597         IF (f_out) CALL guide_out("ucov",jjp1,llm,f_addu(ijb_u:ije_u,:),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
    598613!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    599614        DO l=1,llm
    … …  
    690705        IF (f_out) CALL guide_out("v",jjm,llm,vcov(ijb_v:ije_v,:),factt)
    691706        IF (f_out) CALL guide_out("va",jjm,llm,(1.-tau)*vgui1(ijb_v:ije_v,:)+tau*vgui2(ijb_v:ije_v,:),factt)
    692         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
    693713
    694714!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    … …  
    926946 
    927947  INTEGER                            :: i,j,l,ij
     948  CHARACTER(LEN=20),PARAMETER :: modname="guide_interp"
    928949  TYPE(Request),SAVE :: Req 
    929950!$OMP THREADPRIVATE(Req)
    930     print *,'Guide: conversion variables guidage'
     951   
     952    if (is_master) write(*,*)trim(modname)//': interpolate nudging variables'
    931953! -----------------------------------------------------------------
    932954! Calcul des niveaux de pression champs guidage (pour T et Q)
    … …  
    973995        first=.FALSE.
    974996!$OMP MASTER
    975         print*,'Guide: verification ordre niveaux verticaux'
    976         print*,'LMDZ :'
     997        write(*,*)trim(modname)//' : check vertical level order'
     998        write(*,*)trim(modname)//' LMDZ :'
    977999        do l=1,llm
    978             print*,'PL(',l,')=',(ap(l)+ap(l+1))/2. &
     1000          write(*,*)trim(modname)//' PL(',l,')=',(ap(l)+ap(l+1))/2. &
    9791001                  +psi(1,jjeu)*(bp(l)+bp(l+1))/2.
    9801002        enddo
    981         print*,'Fichiers guidage'
     1003        write(*,*)trim(modname)//' nudging file :'
    9821004        SELECT CASE (guide_plevs)
    9831005        CASE (0)
    9841006            do l=1,nlevnc
    985                  print*,'PL(',l,')=',plnc2(1,jjbu,l)
     1007              write(*,*)trim(modname)//' PL(',l,')=',plnc2(1,jjbu,l)
    9861008            enddo
    9871009        CASE (1)
    9881010            DO l=1,nlevnc
    989                  print*,'PL(',l,')=',apnc(l)+bpnc(l)*psnat2(i,jjbu)
    990              ENDDO
     1011              write(*,*)trim(modname)//' PL(',l,')=',&
     1012                        apnc(l)+bpnc(l)*psnat2(i,jjbu)
     1013            ENDDO
    9911014        CASE (2)
    9921015            do l=1,nlevnc
    993                  print*,'PL(',l,')=',pnat2(1,jjbu,l)
     1016              write(*,*)trim(modname)//' PL(',l,')=',pnat2(1,jjbu,l)
    9941017            enddo
    9951018        END SELECT
    996         print *,'inversion de l''ordre: invert_p=',invert_p
     1019        write(*,*)trim(modname)//' invert ordering: invert_p=',invert_p
    9971020        if (guide_u) then
    9981021            do l=1,nlevnc
    999                 print*,'U(',l,')=',unat2(1,jjbu,l)
     1022              write(*,*)trim(modname)//' U(',l,')=',unat2(1,jjbu,l)
    10001023            enddo
    10011024        endif
    10021025        if (guide_T) then
    10031026            do l=1,nlevnc
    1004                 print*,'T(',l,')=',tnat2(1,jjbu,l)
     1027              write(*,*)trim(modname)//' T(',l,')=',tnat2(1,jjbu,l)
    10051028            enddo
    10061029        endif
    10071030!$OMP END MASTER
    1008     endif
     1031    endif ! of if (first)
    10091032   
    10101033! -----------------------------------------------------------------
    … …  
    14021425    real alphamin,alphamax,xi
    14031426    integer i,j,ilon,ilat
     1427    character(len=20),parameter :: modname="tau2alpha"
    14041428
    14051429
    … …  
    14901514            ! Calcul de gamma
    14911515            if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then
    1492                  print*,'ATTENTION modele peu zoome'
    1493                  print*,'ATTENTION on prend une constante de guidage cste'
    1494                  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.
    14951519            else
    1496                 gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
    1497                 print*,'gamma=',gamma
    1498                 if (gamma.lt.1.e-5) then
    1499                   print*,'gamma =',gamma,'<1e-5'
    1500                   stop
    1501                 endif
    1502                 gamma=log(0.5)/log(gamma)
    1503                 if (gamma4) then
    1504                   gamma=min(gamma,4.)
    1505                 endif
    1506                 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
    15071531            endif
    15081532        ENDIF !first
    … …  
    15451569    IMPLICIT NONE
    15461570
    1547 #include "netcdf.inc"
    1548 #include "dimensions.h"
    1549 #include "paramet.h"
     1571    include "netcdf.inc"
     1572    include "dimensions.h"
     1573    include "paramet.h"
    15501574
    15511575    INTEGER, INTENT(IN)   :: timestep
    … …  
    15551579    INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidp,varidp
    15561580    INTEGER, SAVE         :: ncidQ,varidQ,ncidt,varidt,ncidps,varidps
    1557     INTEGER               :: ncidpl,varidpl,varidap,varidbp
     1581    INTEGER               :: ncidpl,varidpl,varidap,varidbp,dimid,lendim
    15581582! Variables auxiliaires NetCDF:
    15591583    INTEGER, DIMENSION(4) :: start,count
    … …  
    15611585    CHARACTER (len = 80)   :: abort_message
    15621586    CHARACTER (len = 20)   :: modname = 'guide_read'
     1587    CHARACTER (len = 20)   :: namedim
    15631588    abort_message='pb in guide_read'
    15641589
    … …  
    15681593    if (first) then
    15691594         ncidpl=-99
    1570          print*,'Guide: ouverture des fichiers guidage '
     1595         write(*,*),trim(modname)//': opening nudging files '
    15711596! Ap et Bp si Niveaux de pression hybrides
    15721597         if (guide_plevs.EQ.1) then
    1573              print *,'Lecture du guidage sur niveaux modele'
     1598             write(*,*),trim(modname)//' Reading nudging on model levels'
    15741599             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    15751600             IF (rcode.NE.NF_NOERR) THEN
    1576               print *,'Guide: probleme -> pas de fichier apbp.nc'
     1601              abort_message='Nudging: error -> no file apbp.nc'
    15771602              CALL abort_gcm(modname,abort_message,1)
    15781603             ENDIF
    15791604             rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
    15801605             IF (rcode.NE.NF_NOERR) THEN
    1581               print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc'
     1606              abort_message='Nudging: error -> no AP variable in file apbp.nc'
    15821607              CALL abort_gcm(modname,abort_message,1)
    15831608             ENDIF
    15841609             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    15851610             IF (rcode.NE.NF_NOERR) THEN
    1586               print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc'
     1611              abort_message='Nudging: error -> no BP variable in file apbp.nc'
    15871612              CALL abort_gcm(modname,abort_message,1)
    15881613             ENDIF
    1589              print*,'ncidpl,varidap',ncidpl,varidap
     1614             write(*,*),trim(modname)//' ncidpl,varidap',ncidpl,varidap
    15901615         endif
     1616         
    15911617! Pression si guidage sur niveaux P variables
    15921618         if (guide_plevs.EQ.2) then
    15931619             rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
    15941620             IF (rcode.NE.NF_NOERR) THEN
    1595               print *,'Guide: probleme -> pas de fichier P.nc'
     1621              abort_message='Nudging: error -> no file P.nc'
    15961622              CALL abort_gcm(modname,abort_message,1)
    15971623             ENDIF
    15981624             rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
    15991625             IF (rcode.NE.NF_NOERR) THEN
    1600               print *,'Guide: probleme -> pas de variable PRES, fichier P.nc'
     1626              abort_message='Nudging: error -> no PRES variable in file P.nc'
    16011627              CALL abort_gcm(modname,abort_message,1)
    16021628             ENDIF
    1603              print*,'ncidp,varidp',ncidp,varidp
     1629             write(*,*),trim(modname)//' ncidp,varidp',ncidp,varidp
    16041630             if (ncidpl.eq.-99) ncidpl=ncidp
    16051631         endif
     1632
    16061633! Vent zonal
    16071634         if (guide_u) then
    16081635             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    16091636             IF (rcode.NE.NF_NOERR) THEN
    1610               print *,'Guide: probleme -> pas de fichier u.nc'
     1637              abort_message='Nudging: error -> no file u.nc'
    16111638              CALL abort_gcm(modname,abort_message,1)
    16121639             ENDIF
    16131640             rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
    16141641             IF (rcode.NE.NF_NOERR) THEN
    1615               print *,'Guide: probleme -> pas de variable UWND, fichier u.nc'
     1642              abort_message='Nudging: error -> no UWND variable in file u.nc'
    16161643              CALL abort_gcm(modname,abort_message,1)
    16171644             ENDIF
    1618              print*,'ncidu,varidu',ncidu,varidu
     1645             write(*,*),trim(modname)//' ncidu,varidu',ncidu,varidu
    16191646             if (ncidpl.eq.-99) ncidpl=ncidu
     1647
     1648   
     1649             status=NF90_INQ_DIMID(ncidu, "LONU", dimid)
     1650             status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim)
     1651             IF (lendim .NE. iip1) THEN
     1652                abort_message='dimension LONU different from iip1 in u.nc'
     1653                CALL abort_gcm(modname,abort_message,1)
     1654             ENDIF
     1655
     1656             status=NF90_INQ_DIMID(ncidu, "LATU", dimid)
     1657             status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim)
     1658             IF (lendim .NE. jjp1) THEN
     1659                abort_message='dimension LATU different from jjp1 in u.nc'
     1660                CALL abort_gcm(modname,abort_message,1)
     1661             ENDIF
     1662 
    16201663         endif
     1664
    16211665! Vent meridien
    16221666         if (guide_v) then
    16231667             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    16241668             IF (rcode.NE.NF_NOERR) THEN
    1625               print *,'Guide: probleme -> pas de fichier v.nc'
     1669              abort_message='Nudging: error -> no file v.nc'
    16261670              CALL abort_gcm(modname,abort_message,1)
    16271671             ENDIF
    16281672             rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    16291673             IF (rcode.NE.NF_NOERR) THEN
    1630               print *,'Guide: probleme -> pas de variable VWND, fichier v.nc'
     1674              abort_message='Nudging: error -> no VWND variable in file v.nc'
    16311675              CALL abort_gcm(modname,abort_message,1)
    16321676             ENDIF
    1633              print*,'ncidv,varidv',ncidv,varidv
     1677             write(*,*),trim(modname)//' ncidv,varidv',ncidv,varidv
    16341678             if (ncidpl.eq.-99) ncidpl=ncidv
    1635          endif
     1679             
     1680             status=NF90_INQ_DIMID(ncidv, "LONV", dimid)
     1681             status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim)
     1682             
     1683                IF (lendim .NE. iip1) THEN
     1684                abort_message='dimension LONV different from iip1 in v.nc'
     1685                CALL abort_gcm(modname,abort_message,1)
     1686             ENDIF
     1687
     1688
     1689             status=NF90_INQ_DIMID(ncidv, "LATV", dimid)
     1690             status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim)
     1691             IF (lendim .NE. jjm) THEN
     1692                abort_message='dimension LATV different from jjm in v.nc'
     1693                CALL abort_gcm(modname,abort_message,1)
     1694             ENDIF
     1695       
     1696        endif
     1697
    16361698! Temperature
    16371699         if (guide_T) then
    16381700             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    16391701             IF (rcode.NE.NF_NOERR) THEN
    1640               print *,'Guide: probleme -> pas de fichier T.nc'
     1702              abort_message='Nudging: error -> no file T.nc'
    16411703              CALL abort_gcm(modname,abort_message,1)
    16421704             ENDIF
    16431705             rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    16441706             IF (rcode.NE.NF_NOERR) THEN
    1645               print *,'Guide: probleme -> pas de variable AIR, fichier T.nc'
     1707              abort_message='Nudging: error -> no AIR variable in file T.nc'
    16461708              CALL abort_gcm(modname,abort_message,1)
    16471709             ENDIF
    1648              print*,'ncidT,varidT',ncidt,varidt
     1710             write(*,*),trim(modname)//' ncidT,varidT',ncidt,varidt
    16491711             if (ncidpl.eq.-99) ncidpl=ncidt
     1712
     1713             status=NF90_INQ_DIMID(ncidt, "LONV", dimid)
     1714             status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim)
     1715             IF (lendim .NE. iip1) THEN
     1716                abort_message='dimension LONV different from iip1 in T.nc'
     1717                CALL abort_gcm(modname,abort_message,1)
     1718             ENDIF
     1719
     1720             status=NF90_INQ_DIMID(ncidt, "LATU", dimid)
     1721             status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim)
     1722             IF (lendim .NE. jjp1) THEN
     1723                abort_message='dimension LATU different from jjp1 in T.nc'
     1724                CALL abort_gcm(modname,abort_message,1)
     1725             ENDIF
     1726
    16501727         endif
     1728
    16511729! Humidite
    16521730         if (guide_Q) then
    16531731             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    16541732             IF (rcode.NE.NF_NOERR) THEN
    1655               print *,'Guide: probleme -> pas de fichier hur.nc'
     1733              abort_message='Nudging: error -> no file hur.nc'
    16561734              CALL abort_gcm(modname,abort_message,1)
    16571735             ENDIF
    16581736             rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    16591737             IF (rcode.NE.NF_NOERR) THEN
    1660               print *,'Guide: probleme -> pas de variable RH, fichier hur.nc'
     1738              abort_message='Nudging: error -> no RH variable in file hur.nc'
    16611739              CALL abort_gcm(modname,abort_message,1)
    16621740             ENDIF
    1663              print*,'ncidQ,varidQ',ncidQ,varidQ
     1741             write(*,*),trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
    16641742             if (ncidpl.eq.-99) ncidpl=ncidQ
     1743
     1744
     1745             status=NF90_INQ_DIMID(ncidQ, "LONV", dimid)
     1746             status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim)
     1747             IF (lendim .NE. iip1) THEN
     1748                abort_message='dimension LONV different from iip1 in hur.nc'
     1749                CALL abort_gcm(modname,abort_message,1)
     1750             ENDIF
     1751
     1752             status=NF90_INQ_DIMID(ncidQ, "LATU", dimid)
     1753             status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim)
     1754             IF (lendim .NE. jjp1) THEN
     1755                abort_message='dimension LATU different from jjp1 in hur.nc'
     1756                CALL abort_gcm(modname,abort_message,1)
     1757             ENDIF
     1758
     1759
    16651760         endif
    16661761! Pression de surface
    … …  
    16681763             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    16691764             IF (rcode.NE.NF_NOERR) THEN
    1670               print *,'Guide: probleme -> pas de fichier ps.nc'
     1765              abort_message='Nudging: error -> no file ps.nc'
    16711766              CALL abort_gcm(modname,abort_message,1)
    16721767             ENDIF
    16731768             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    16741769             IF (rcode.NE.NF_NOERR) THEN
    1675               print *,'Guide: probleme -> pas de variable SP, fichier ps.nc'
     1770              abort_message='Nudging: error -> no SP variable in file ps.nc'
    16761771              CALL abort_gcm(modname,abort_message,1)
    16771772             ENDIF
    1678              print*,'ncidps,varidps',ncidps,varidps
     1773             write(*,*),trim(modname)//' ncidps,varidps',ncidps,varidps
    16791774         endif
    16801775! Coordonnee verticale
    … …  
    16821777              rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    16831778              IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    1684               print*,'ncidpl,varidpl',ncidpl,varidpl
     1779              write(*,*),trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
    16851780         endif
    16861781! Coefs ap, bp pour calcul de la pression aux differents niveaux
    … …  
    18271922    IMPLICIT NONE
    18281923
    1829 #include "netcdf.inc"
    1830 #include "dimensions.h"
    1831 #include "paramet.h"
     1924    include "netcdf.inc"
     1925    include "dimensions.h"
     1926    include "paramet.h"
    18321927
    18331928    INTEGER, INTENT(IN)   :: timestep
    … …  
    18541949    if (first) then
    18551950         ncidpl=-99
    1856          print*,'Guide: ouverture des fichiers guidage '
     1951         write(*,*)trim(modname)//' : opening nudging files '
    18571952! Ap et Bp si niveaux de pression hybrides
    18581953         if (guide_plevs.EQ.1) then
    1859              print *,'Lecture du guidage sur niveaux mod�le'
    1860              rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    1861              IF (rcode.NE.NF_NOERR) THEN
    1862               print *,'Guide: probleme -> pas de fichier apbp.nc'
    1863               CALL abort_gcm(modname,abort_message,1)
    1864              ENDIF
    1865              rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
    1866              IF (rcode.NE.NF_NOERR) THEN
    1867               print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc'
    1868               CALL abort_gcm(modname,abort_message,1)
    1869              ENDIF
    1870              rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    1871              IF (rcode.NE.NF_NOERR) THEN
    1872               print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc'
    1873               CALL abort_gcm(modname,abort_message,1)
    1874              ENDIF
    1875              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
    18761971         endif
    18771972! Pression
    18781973         if (guide_plevs.EQ.2) then
    1879              rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
    1880              IF (rcode.NE.NF_NOERR) THEN
    1881               print *,'Guide: probleme -> pas de fichier P.nc'
    1882               CALL abort_gcm(modname,abort_message,1)
    1883              ENDIF
    1884              rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
    1885              IF (rcode.NE.NF_NOERR) THEN
    1886               print *,'Guide: probleme -> pas de variable PRES, fichier P.nc'
    1887               CALL abort_gcm(modname,abort_message,1)
    1888              ENDIF
    1889              print*,'ncidp,varidp',ncidp,varidp
    1890              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
    18911986         endif
    18921987! Vent zonal
    18931988         if (guide_u) then
    1894              rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    1895              IF (rcode.NE.NF_NOERR) THEN
    1896               print *,'Guide: probleme -> pas de fichier u.nc'
    1897               CALL abort_gcm(modname,abort_message,1)
    1898              ENDIF
    1899              rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
    1900              IF (rcode.NE.NF_NOERR) THEN
    1901               print *,'Guide: probleme -> pas de variable UWND, fichier u.nc'
    1902               CALL abort_gcm(modname,abort_message,1)
    1903              ENDIF
    1904              print*,'ncidu,varidu',ncidu,varidu
    1905              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
    19062001         endif
    19072002
    19082003! Vent meridien
    19092004         if (guide_v) then
    1910              rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    1911              IF (rcode.NE.NF_NOERR) THEN
    1912               print *,'Guide: probleme -> pas de fichier v.nc'
    1913               CALL abort_gcm(modname,abort_message,1)
    1914              ENDIF
    1915              rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    1916              IF (rcode.NE.NF_NOERR) THEN
    1917               print *,'Guide: probleme -> pas de variable VWND, fichier v.nc'
    1918               CALL abort_gcm(modname,abort_message,1)
    1919              ENDIF
    1920              print*,'ncidv,varidv',ncidv,varidv
    1921              if (ncidpl.eq.-99) ncidpl=ncidv
    1922          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
    19232018! Temperature
    19242019         if (guide_T) then
    1925              rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    1926              IF (rcode.NE.NF_NOERR) THEN
    1927               print *,'Guide: probleme -> pas de fichier T.nc'
    1928               CALL abort_gcm(modname,abort_message,1)
    1929              ENDIF
    1930              rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    1931              IF (rcode.NE.NF_NOERR) THEN
    1932               print *,'Guide: probleme -> pas de variable AIR, fichier T.nc'
    1933               CALL abort_gcm(modname,abort_message,1)
    1934              ENDIF
    1935              print*,'ncidT,varidT',ncidt,varidt
    1936              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
    19372032         endif
    19382033! Humidite
    19392034         if (guide_Q) then
    1940              rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    1941              IF (rcode.NE.NF_NOERR) THEN
    1942               print *,'Guide: probleme -> pas de fichier hur.nc'
    1943               CALL abort_gcm(modname,abort_message,1)
    1944              ENDIF
    1945              rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    1946              IF (rcode.NE.NF_NOERR) THEN
    1947               print *,'Guide: probleme -> pas de variable RH, fichier hur.nc'
    1948               CALL abort_gcm(modname,abort_message,1)
    1949              ENDIF
    1950              print*,'ncidQ,varidQ',ncidQ,varidQ
    1951              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
    19522047         endif
    19532048! Pression de surface
    19542049         if ((guide_P).OR.(guide_plevs.EQ.1)) then
    1955              rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    1956              IF (rcode.NE.NF_NOERR) THEN
    1957               print *,'Guide: probleme -> pas de fichier ps.nc'
    1958               CALL abort_gcm(modname,abort_message,1)
    1959              ENDIF
    1960              rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    1961              IF (rcode.NE.NF_NOERR) THEN
    1962               print *,'Guide: probleme -> pas de variable SP, fichier ps.nc'
    1963               CALL abort_gcm(modname,abort_message,1)
    1964              ENDIF
    1965              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
    19662061         endif
    19672062! Coordonnee verticale
    19682063         if (guide_plevs.EQ.0) then
    1969               rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    1970               IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    1971               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
    19722067         endif
    19732068! Coefs ap, bp pour calcul de la pression aux differents niveaux
    … …  
    21632258    REAL zu(ip1jmp1),zv(ip1jm), zt(iip1, jjp1), zq(iip1, jjp1)
    21642259    REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: field_glo
     2260    CHARACTER(LEN=20),PARAMETER :: modname="guide_out"
    21652261   
    21662262!$OMP MASTER
    … …  
    21692265!$OMP BARRIER
    21702266
    2171     print*,'gvide_out apres allocation ',hsize,vsize
     2267!    write(*,*)trim(modname)//' after allocation ',hsize,vsize
    21722268
    21732269    IF (hsize==jjp1) THEN
    … …  
    21772273    ENDIF
    21782274
    2179     print*,'guide_out apres gather '
     2275!    write(*,*)trim(modname)//' after gather '
    21802276    CALL Gather_field_u(alpha_u,zu,1)
    21812277    CALL Gather_field_u(alpha_t,zt,1)
    … …  
    23472443!$OMP BARRIER
    23482444
    2349     RETURN
    2350 
    23512445  END SUBROUTINE guide_out
    23522446   
Note: See TracChangeset for help on using the changeset viewer.