Changeset 5463 for LMDZ6/trunk/libf/phylmd/Dust/read_surface.f90
- Timestamp:
- Dec 31, 2024, 5:53:47 PM (5 days ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/Dust/read_surface.f90
r5337 r5463 31 31 real surfa_glo(klon_glo,5) 32 32 ! 33 integer ncid, varid, rcode 34 integer start (2),count(2),status33 integer ncid, varid, rcode, varlatid,tmpid 34 integer start_(2),count_(2) 35 35 integer i,j,l,ig 36 36 character*1 str1 … … 41 41 real, dimension(nbp_lat) :: lats 42 42 real, dimension(nbp_lat) :: lats_glo 43 integer, dimension(1) :: start j,endj43 integer, dimension(1) :: start_j,endj 44 44 !JE20140526>> 45 45 !$OMP MASTER … … 47 47 48 48 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 50 52 51 53 !JE20140526<<: check if are inversed or not the latitude grid in donnes_lisa … … 54 56 isinversed=.false. 55 57 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 68 68 enddo ! check if it inversed lat 69 startj(1)=1 70 ! endj(1)=jjp1 69 start_j(1)=1 71 70 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 73 73 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 79 75 80 76 ! check if netcdf is latitude inversed or not. … … 86 82 write(str1,'(i1)') i 87 83 varname=trim(name)//str1 88 print*,'lecture variable:',varname89 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 90 86 ! varid=nf90_inq_varid(ncid,varname,rcode) 91 87 … … 93 89 ! ----------------------------------------------------- 94 90 95 start (1)=196 start (2)=197 count (1)=nbp_lon+198 ! count (1)=iip199 count (2)=nbp_lat100 ! count (2)=jjp191 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 101 97 102 98 ! mise a zero des tableaux … … 106 102 ! Lecture 107 103 ! ----------------------- 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 109 106 110 107 ! call dump2d(iip1,jjp1,tmp_dyn,'tmp_dyn ')
Note: See TracChangeset
for help on using the changeset viewer.