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

File:
1 edited

Legend:

Unmodified
Added
Removed

  • 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   
Note: See TracChangeset for help on using the changeset viewer.