Ignore:
Timestamp:
Dec 31, 2024, 5:53:47 PM (5 days ago)
Author:
fhourdin
Message:

Bug fix for nf90_open in Dust routines

File:
1 edited

Legend:

Unmodified
Added
Removed
  • LMDZ6/trunk/libf/phylmd/Dust/read_surface.f90

    r5337 r5463  
    3131       real surfa_glo(klon_glo,5)
    3232!
    33        integer ncid, varid, rcode
    34        integer start(2),count(2),status
     33       integer ncid, varid, rcode, varlatid,tmpid
     34       integer start_(2),count_(2)
    3535       integer i,j,l,ig
    3636       character*1 str1
     
    4141      real, dimension(nbp_lat) :: lats
    4242      real, dimension(nbp_lat) :: lats_glo
    43       integer, dimension(1) :: startj,endj
     43      integer, dimension(1) :: start_j,endj
    4444!JE20140526>>
    4545!$OMP MASTER
     
    4747
    4848       print*,'Lecture du fichier donnees_lisa.nc'
    49        ncid=nf90_open('donnees_lisa.nc',nf90_nowrite,rcode)
     49       rcode=nf90_open('donnees_lisa.nc',nf90_nowrite,ncid)
     50       if ( rcode /= 0 ) then ; call abort_physic('LMDZ','open donnees_lisa.nc dans read_vent',1) ; endif
     51
    5052
    5153!JE20140526<<: check if are inversed or not the latitude grid in donnes_lisa
     
    5456      isinversed=.false.
    5557      do i=1,5
    56        if (i==1) aux4s='latu'
    57        if (i==2) aux4s='LATU'
    58        if (i==3) aux4s='LatU'
    59        if (i==4) aux4s='Latu'
    60        if (i==5) aux4s='latU'
    61        status = nf90_inq_varid(ncid, aux4s, rcode)
    62 !       print *,'stat,i',status,i,outcycle,aux4s
    63 !       print *,'ifclause',status.NE. nf90_noerr ,outcycle == .false.
    64        IF ((.not.(status.NE. nf90_noerr) ).and.( .not. outcycle )) THEN
    65          outcycle=.true.
    66          latstr=aux4s
    67        ENDIF
     58          if (i==1) aux4s='latu'
     59          if (i==2) aux4s='LATU'
     60          if (i==3) aux4s='LatU'
     61          if (i==4) aux4s='Latu'
     62          if (i==5) aux4s='latU'
     63          rcode = nf90_inq_varid(ncid, aux4s, tmpid)
     64          IF ((rcode==0).and.( .not. outcycle )) THEN
     65            outcycle=.true.
     66            varlatid=tmpid
     67          ENDIF
    6868      enddo ! check if it inversed lat
    69       startj(1)=1
    70 !      endj(1)=jjp1
     69      start_j(1)=1
    7170      endj(1)=nbp_lat
    72       varid=nf90_inq_varid(ncid,latstr,rcode)
     71      rcode = nf90_get_var(ncid, varlatid, lats_glo, start_j, endj)
     72      if ( .not. outcycle ) then ; call abort_physic('LMDZ','get lat dans read_surface',1) ; endif
    7373
    74           status = nf90_get_var(ncid, varid, lats_glo, startj, endj)
    75 !      print *,latstr,varid,status,jjp1,rcode
    76 !      IF (status .NE. nf90_noerr) print*,'NOOOOOOO'
    77 !      print *,lats
    78 !stop
     74
    7975
    8076! check if netcdf is latitude inversed or not.
     
    8682          write(str1,'(i1)') i
    8783          varname=trim(name)//str1
    88        print*,'lecture variable:',varname
    89           varid=nf90_inq_varid(ncid,trim(varname),rcode)
     84          rcode=nf90_inq_varid(ncid,trim(varname),varid)
     85          if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get'//varname//'  dans read_vent',1) ; endif
    9086!          varid=nf90_inq_varid(ncid,varname,rcode)
    9187
     
    9389!  -----------------------------------------------------
    9490
    95           start(1)=1
    96           start(2)=1     
    97           count(1)=nbp_lon+1
    98 !          count(1)=iip1
    99           count(2)=nbp_lat
    100 !          count(2)=jjp1
     91          start_(1)=1
     92          start_(2)=1     
     93          count_(1)=nbp_lon+1
     94!          count_(1)=iip1
     95          count_(2)=nbp_lat
     96!          count_(2)=jjp1
    10197
    10298! mise a zero des tableaux
     
    106102! Lecture
    107103! -----------------------
    108           status = nf90_get_var(ncid, varid, tmp_dyn_glo, start, count)
     104          rcode = nf90_get_var(ncid, varid, tmp_dyn_glo, start_, count_)
     105          if ( rcode /= 0 ) then ; call abort_physic('LMDZ','get'//varname//'  dans read_vent',1) ; endif
    109106
    110107!      call dump2d(iip1,jjp1,tmp_dyn,'tmp_dyn   ')
Note: See TracChangeset for help on using the changeset viewer.