copyright (C) 2001 MSC-RPN COMM %%%MC2%%% ***s/r getlvls *subroutine getlvls (refip1,nlvls,nkfin,datestp,nomvar,iun,verbose) 2 implicit none * character* (*) nomvar logical verbose integer nlvls,nkfin,datestp,iun integer refip1(nkfin) * #include "yomdyn.cdk"
* ** integer nlis parameter (nlis = 1024) integer liste (nlis) character*16 date character*12 etktdm,mesglvl,dum character*4 nvardm character*2 tvardm character*1 grtypdm integer fstinl,fstprm external fstinl,fstprm integer idetdm,npasdm,nbitdm,idtpdm,ig1,ig2,ig3,ig4,swadm,ilngdm, $ idtfdm,iubcdm,ixt1dm,ixt2dm,ixt3dm,ip1,ip2,ip3,tmpdate, $ ilvls,nrec,ni,nj,nk,lislon,ier,i,j,k,kind,tmpip1(nkfin) real pref(nkfin),pref2(nkfin),eps * *-------------------------------------------------------------------- * ilvls = 0 nlvls = ilvls * nrec= fstinl (iun,ni,nj,nk,datestp,' ',-1,-1,-1,' ',nomvar, $ liste,lislon,nlis) if ((lislon.eq.0).and.(nomvar.eq.'TT')) $ nrec= fstinl (iun,ni,nj,nk,datestp,' ',-1,-1,-1,' ','VT', $ liste,lislon,nlis) * if (lislon.gt.nkfin) then write (6,800) lislon stop endif do i=1,lislon ier=fstprm (liste(i),tmpdate,idetdm,npasdm,ni,nj,nk, $ nbitdm,idtpdm,ip1,ip2,ip3,tvardm,nvardm,etktdm, $ grtypdm,ig1,ig2,ig3,ig4,swadm,ilngdm,idtfdm,iubcdm, $ ixt1dm,ixt2dm,ixt3dm) if (ip1.gt.0) then ilvls = ilvls+1 tmpip1(ilvls) = ip1 endif end do * if (ilvls.le.0) return * write(6,900) nvardm nlvls = ilvls * do i=1,nlvls call convip ( tmpip1(i), pref(i), kind , -1, dum, .false. ) end do pref2=pref call sort (pref,nlvls) do i=1,nlvls do j=1,nlvls eps = pref(i)*1.0e-5 if((pref(i).ge.pref2(j)-eps).and.(pref(i).le.pref2(j)+eps)) $ k = j end do refip1(i) = tmpip1(k) end do * if (kind.eq.4) then gngalsig = 1 mesglvl='Gal-Chen' endif if (kind.eq.1) then gngalsig = 2 mesglvl='Sigma' endif if (kind.eq.2) then gngalsig = 0 mesglvl='Pressure' endif * if (verbose) then write (6,300) write (6,320) nlvls,mesglvl,nomvar write (6,300) do i=1,nlvls write (6,600) i,pref(i) end do write (6,300) print* endif *-------------------------------------------------------------------- 300 format (75('*')) 320 format ('(GETLVLS) Found the following:',i4,1x,a9, $ ' levels for this dataset',1x,'(',a4,')') 600 format (i5,f12.5) 800 format (/1x,"PROBLEM IN ROUTINE ""GETLVLS"""/ $ 1x,"THERE ARE",i4," LEVELS IN THIS DATASET."/ $ 1x,"INCREASE THE LENGTH OF VECTOR pref"/) 900 format (1x,"(GETLVLS):",1x,"VARIABLE (",a, $ ") was used to determined vertical structure of dataset") return end