!-------------------------------------- LICENCE BEGIN ------------------------------------ !Environment Canada - Atmospheric Science and Technology License/Disclaimer, ! version 3; Last Modified: May 7, 2008. !This is free but copyrighted software; you can use/redistribute/modify it under the terms !of the Environment Canada - Atmospheric Science and Technology License/Disclaimer !version 3 or (at your option) any later version that should be found at: !http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html ! !This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; !without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. !See the above mentioned License/Disclaimer for more details. !You should have received a copy of the License/Disclaimer along with this software; !if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec), !CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca !-------------------------------------- LICENCE END -------------------------------------- copyright (C) 2001 MSC-RPN COMM %%%MC2%%% ***s/r e_pilotf *integer function e_pilotf (datev,nomvar,etk,typvar,ip1,ip2,ip3) 4,1 implicit none * character* (*) nomvar,etk,typvar integer datev,ip1,ip2,ip3 * *AUTHOR M. Desgagne November 2001 * *revision * v3_30 - Desgagne M - to search the list again if a record is not found * *IMPLICIT #include "e_fu.cdk"
#include "filename.cdk"
#include "path.cdk"
* integer fnom,fstouv,fstinf,fstfrm,fclos external fnom,fstouv,fstinf,fstfrm,fclos character*16 date character*512 fn logical done integer i,ier,ni1,nj1,nk1 data done /.false./ save done * *--------------------------------------------------------------------- * e_pilotf = -1 e_fu_anal = 0 * 55 do i = max(1,ipilf), npilf fn= trim(pilot_dir )//'/'//trim(pilot_f(i)) ier = fnom (e_fu_anal,fn,'RND+OLD+R/O',0) ier = fstouv (e_fu_anal,'RND') e_pilotf = fstinf ( e_fu_anal,ni1,nj1,nk1,datev,etk, $ ip1,ip2,ip3,typvar,nomvar ) if ( e_pilotf.ge.0 ) then ipilf = i goto 879 endif ier = fstfrm (e_fu_anal) ier = fclos (e_fu_anal) end do if (e_pilotf.lt.0 .and. .not.done) then ipilf = 1 done = .true. goto 55 endif * 879 call datf2p
(date,datev) if (e_pilotf.ge.0) then print*, "(E_PILOTF): FOUND ",nomvar,' valid at ',date, ' in ', $ trim(pilot_f(i)) else e_fu_anal = -1 print*, "(E_PILOTF): COUD NOT FIND: ",nomvar,' valid at ',date, $ ' in pilot directory' endif print* * *--------------------------------------------------------------------- * return end