text:
      SUBROUTINE HCLEAR  ( iret )
C************************************************************************
C* HCLEAR - GN								*
C* 									*
C* This subroutine clears the current device.  On a direct access 	*
C* device, HCLEAR erases the screen.  On a continuous paper plotter, 	*
C* HCLEAR will advance  to the next page.  On a single page plotter, 	*
C* HCLEAR will unload the paper so another sheet can be loaded. 	*
C* 									*
C* HCLEAR  ( IRET )							*
C*									*
C* Output parameters:							*
C*	IRET		INTEGER		Return code			*
C**									*
C* Log:									*
C* S. Maxwell/GSC	 6/97		Documentation changes		*
C************************************************************************
	INCLUDE		'ERROR.PRM'
C------------------------------------------------------------------------
	iret = NORMAL
C*
	RETURN
	END

ext: f

max_stars_repo_name: oxelson/gempak

max_issues_repo_name: oxelson/gempak

max_forks_repo_name: oxelson/gempak


text:
HANSARD REVISE * NUMERO 97
Le vendredi 1 er mai 1998
LOI SUR L'EDUCATION DES MI'KMAQ
M. Leon E. Benoit
Mme Jocelyne Girard-Bujold
LES EAGLES DE SOUTH SURREY
L'hon. Ralph E. Goodale
L'hon. Ralph E. Goodale
L'hon. Ethel Blondin-Andrew
LA GENDARMERIE ROYALE DU CANADA
LA GENDARMERIE ROYALE DU CANADA
REPONSE DU GOUVERNEMENT A DES PETITIONS
LES COMITES DE LA CHAMBRE
Procedure et affaires de la Chambre
QUESTIONS TRANSFORMEES EN ORDRES DE DEPOT DE DOCUMENTS
LOI SUR L'EDUCATION DES MI'KMAQ
M. Leon E. Benoit
LES COMITES DE LA CHAMBRE
LOI SUR L'EDUCATION DES MI'KMAQ.
Report du vote sur la motion
HANSARD REVISE * NUMERO 97
Le vendredi 1 er mai 1998
La seance est ouverte a 10 heures.
LOI SUR L'EDUCATION DES MI'KMAQ
Le projet de loi C-30 n'est ni long ni complexe.
Il porte sur une question bien precise pour un groupe distinct de personnes.
Pourquoi ce projet de loi est-il si important?
Nous avons bon espoir que cela conduira a bien d'autres initiatives de ce genre.
Cela n'est pas un nouveau concept.
Ce projet de loi represente une etape importante dans l'atteinte de cet objectif.
Les montants de l'aide financiere seront reevalues tous les cinq ans.
Ce fait sera confirme par une loi provinciale distincte.
Je demande aujourd'hui aux deputes de tenir compte de cette resolution.
M. Derrek Konrad (Prince Albert, Ref.):
Ils sont venus faire valoir les avantages de ce projet de loi.
M. Deepak Obhrai (Calgary-Est, Ref.):
Nous l'appuierions si les amendements que nous proposons y etaient apportes.
Nous voulons egalement qu'ils soient des participants egaux de la societe canadienne.
L'experience a cependant demontre que ce n'est pas ce qui se produit.
Il y a lieu de se demander comment le conseil sera dirige.
Pourquoi ce principe ne s'appliquerait-il pas ici?
Ce n'est pas ce que prevoit le projet de loi.
C'est la notre principale preoccupation.
Comment les membres de la bande pourront-ils contribuer a definir la politique scolaire?
Nous ne devrions pas etre separes.
Nous ne devrions pas etre compartimentes.
Comment apprendront-ils ce qu'est la fraternite?
Ce qu'est la camaraderie?
Nous devrions nous tenir les coudes.
J'ai mes reserves a propos de ce projet de loi.
M. Ghislain Fournier (Manicouagan, BQ):
Les Mi'kmaq reclament depuis toutes ces annees les pleins pouvoirs en matiere d'education.
Cet obstacle est venu du gouvernement federal a l'epoque.
Mais il y a eu des surprises, notamment sur le plan des immobilisations.
Il faut donc leur accorder une plus grande autonomie gouvernementale.
Le projet de loi est un bel exemple de cette position.
Les consultations qui ont mene a ce projet de loi ont ete tres longues.
Je m'interroge sur la nouvelle definition du mot communaute dans le projet de loi.
Deuxiemement, les mots collectivite et communaute veulent-ils dire la meme chose?
Rationalisation oblige, les commissions scolaires se sont pliees aux exigences du gouvernement.
La distance entre les villes est enorme dans certains cas.
La commission scolaire de Fermont, par exemple, a ete fusionnee a celle de Sept-Iles.
Le seul moyen de transport pour relier ces deux villes est l'avion.
Pas moyen de batir quoi que ce soit dans l'ignorance.
M. Leon E. Benoit (Lakeland, Ref.):
Or, les Mi'kmaq de la Nouvelle-Ecosse travaillaient a ce dossier depuis janvier 1991.
Le projet de loi dont nous sommes saisis est le premier du genre.
Je reviendrai tout a l'heure sur cet aspect.
Jusqu'a maintenant, quatre groupes n'ont pas appuye le projet de loi.
Le depute n'a pas besoin du consentement de la Chambre pour partager son temps.
Il peut le partager parce nous sommes a la periode des discours de 20 minutes.
M. Leon E. Benoit:
Merci, monsieur le President.
Je vous sais gre de cette explication.
Les 13 reserves n'ont pas toutes appuye le projet de loi.
Cher collegue, vous aurez bien sur la parole quand nous reprendrons le debat.
Comme il est presque 11 heures, nous passons maintenant aux declarations de deputes.
M. Larry McCormick (Hastings-Frontenac-Lennox and Addington, Lib.):
Je souhaite a tous les participants une bonne et agreable fin de semaine.
M. John Reynolds (West Vancouver-Sunshine Coast, Ref.):
Leur mantra est l'opportunisme, pas la compassion.
Plusieurs transfusions et 12 operations chirurgicales lui ont sauve la vie, en quelque sorte.
Sara a recu du sang contamine au cours des transfusions.
Elle est une victime, pas un dossier.
M. David Pratt (Nepean-Carleton, Lib.):
Ils collecteront aussi des fonds pour la Societe canadienne du cancer.
Je felicite tous ceux qui ont participe au projet du sommet de l'unite.
M. Walt Lastewka (St. Catharines, Lib.):
L'eglise a ete construite de 1944 a 1946 pour accueillir une population ukrainienne croissante.
Les premiers colons ukrainiens s'etaient etablis a St. Catharines au debut des annees 1900.
Mme Eleni Bakopanos (Ahuntsic, Lib.):
M. Deepak Obhrai (Calgary-Est, Ref.):
Prenons un moment de reflexion pour nous feliciter de nos realisations.
M. Jacques Saada (Brossard-La Prairie, Lib.):
Les travailleurs seront donc appeles, toujours davantage, a y participer.
M. Ghislain Fournier (Manicouagan, BQ):
M. Denis Coderre (Bourassa, Lib.):
M. Ken Epp (Elk Island, Ref.):
De la part des liberaux, on n'entend que des declarations contradictoires.
En 1993, le premier ministre promettait un Senat elu.
En tant que premier ministre, je pourrais rendre la chose possible.
Maintenant qu'il est au pouvoir, il fait tout le contraire.
Que penser du senateur liberal Nick Taylor?
Quelle insulte pour les candidats.
Quelle insulte pour les Albertains.
Quelle insulte pour les personnes souffrant de troubles psychiatriques.
Il devrait avoir honte.
Mme Brenda Chamberlain (Guelph-Wellington, Lib.):
Je salue les travailleurs du Canada.
M. Pat Martin (Winnipeg-Centre, NPD):
Le 1 er mai, les syndicalistes canadiens se souviennent de nos propres luttes.
C'est tous ensemble que nous pouvons progresser.
L'hon. Charles Caccia (Davenport, Lib.):
M. Gilles Bernier (Tobique-Mactaquac, PC):
Ils seront places dans un etablissement et leur qualite de vie en souffrira.
Charles et ses parents n'ont pas choisi qu'il soit handicape.
Mme Jocelyne Girard-Bujold (Jonquiere, BQ):
M. Peter MacKay (Pictou-Antigonish-Guysborough, PC):
LES EAGLES DE SOUTH SURREY
M. Gurmant Grewal (Surrey-Centre, Ref.):
M. Preston Manning (chef de l'opposition, Ref.):
L'hon. Herb Gray (vice-premier ministre, Lib.):
Cela n'a pas change.
M. Preston Manning (chef de l'opposition, Ref.):
Elles ont ete salies a la Chambre en ce qui concerne leur role.
Ce sont elles qui paient les frais medicaux des victimes.
L'hon. Herb Gray (vice-premier ministre, Lib.):
Et voila qu'il lance une nouvelle attaque en versant des larmes de crocodile.
M. Preston Manning (chef de l'opposition, Ref.):
Monsieur le President, un vrai chef ferait trois choses pour ces victimes.
L'hon. Allan Rock (ministre de la Sante, Lib.):
J'ai participe aux negociations.
M. Grant Hill (Macleod, Ref.):
Le premier ministre prevoit-il au moins discuter avec les provinces pour...
Je regrette d'interrompre l'honorable depute.
Je cede maintenant la parole a l'honorable ministre de la Sante.
L'hon. Allan Rock (ministre de la Sante, Lib.):
Cette semaine, il a change sa position sur les questions de la periode appropriee.
Il a pose un geste cynique et vide de sens.
Il s'agit de la politique a son pire.
C'est cynique, inapproprie et cruel pour les victimes.
M. Grant Hill (Macleod, Ref.):
Monsieur le President, un ministre sans credibilite signifie une reponse sans credibilite.
Les provinces ont simplement dit qu'elles etaient maintenant pretes a discuter.
L'hon. Herb Gray (vice-premier ministre, Lib.):
Mme Suzanne Tremblay (Rimouski-Mitis, BQ):
L'hon. Allan Rock (ministre de la Sante, Lib.):
Monsieur le President, la position prise par le gouvernement du Quebec cette semaine est inacceptable.
Cette position n'est pas appropriee.
La population sait bien que c'est un geste cynique et inacceptable.
Ils n'ajoutent rien au debat.
La deputee de Rimouski-Mitis.
Mme Suzanne Tremblay (Rimouski-Mitis, BQ):
L'hon. Allan Rock (ministre de la Sante, Lib.):
Le ministre Rochon m'a souvent dit que la sante etait une juridiction exclusivement provinciale.
Ce n'est pas vrai.
C'est cynique et absolument inacceptable.
M. Real Menard (Hochelaga-Maisonneuve, BQ):
Monsieur le President, ma question est pour le ministre de la Sante.
L'hon. Herb Gray (vice-premier ministre, Lib.):
Monsieur le President, le gouvernement a deja accepte que les provinces partagent la responsabilite.
C'est trop tard pour dire que les provinces n'ont pas de responsabilites.
Les provinces, surtout la province de Quebec, ont deja admis et accepte cette responsabilite.
M. Real Menard (Hochelaga-Maisonneuve, BQ):
L'hon. Herb Gray (vice-premier ministre, Lib.):
Le federal n'est pas implique la-dedans.
M. Rock n'a qu'une seule implication: le respect des normes et des standards.
Cela illustre de facon tres importante la responsabilite des provinces dans ce dossier.
L'hon. Lorne Nystrom (Qu'Appelle, NPD):
Monsieur le President, ma question s'adresse au ministre de la Sante.
L'hon. Allan Rock (ministre de la Sante, Lib.):
Monsieur le President, l'honorable depute n'a pas raison.
Il faut lire les reponses de Lucien Bouchard et Jean Rochon.
Ce sont les mots de Lucien Bouchard et Jean Rochon cette semaine.
Ils ont change leur position...
L'honorable depute de Qu'Appelle a la parole.
L'hon. Lorne Nystrom (Qu'Appelle, NPD):
Monsieur le President, il ne s'agit pas de sauver la face.
Le dossier est ouvert.
Je le repete, monsieur le Ministre, le dossier est ouvert.
Je demande au depute de bien vouloir adresser ses questions a la presidence.
Je le prie de poser tout de suite sa question.
L'hon. Allan Rock (ministre de la Sante, Lib.):
M. Gilles Bernier (Tobique-Mactaquac, PC):
L'hon. Allan Rock (ministre de la Sante, Lib.):
Les Canadiens se rendront bien compte de ce qu'il en est.
M. Gilles Bernier (Tobique-Mactaquac, PC):
C'est lui qui prend la decision finale en matiere d'indemnisation.
Le ministre n'a que deux choix.
L'hon. Allan Rock (ministre de la Sante, Lib.):
J'agirai comme il se doit.
En fin de compte, c'est cela, notre devoir le plus fondamental.
M. Preston Manning (chef de l'opposition, Ref.):
Je dirai a la Chambre ce qui est cynique et sans coeur.
L'hon. Allan Rock (ministre de la Sante, Lib.):
Ils ne comprennent meme pas le plan d'indemnisation.
Ils ne savent pas ce que nous offrons.
Mais ils n'hesitent pas a lancer des injures...
La parole est au chef de l'opposition.
M. Preston Manning (chef de l'opposition, Ref.):
Monsieur le President, je dirai a la Chambre ce qui est edifiant.
Pourquoi sommes-nous obliges d'entendre sans cesse les memes arguments?
L'hon. Herb Gray (vice-premier ministre, Lib.):
Ils l'appuient toujours.
Ils acceptent d'assumer leur responsabilite.
Mme Helene Alarie (Louis-Hebert, BQ):
Monsieur le President, ma question s'adresse au president du Conseil du Tresor.
L'equite salariale n'est pas une question de negociation, mais une question de justice.
Mme Helene Alarie (Louis-Hebert, BQ):
M. Maurice Vellacott (Wanuskewin, Ref.):
Il n'a pas reconnu que les provinces n'etaient pas a blamer.
Les coupables, ce sont le gouvernement federal et ses charges de la reglementation.
Le ministre de la Sante.
L'hon. Allan Rock (ministre de la Sante, Lib.):
C'est un principe important.
M. Maurice Vellacott (Wanuskewin, Ref.):
Les provinces n'avaient aucun pouvoir legal en la matiere.
Il est irresponsable de la part du premier ministre de blamer maintenant les provinces.
Il est pueril et mesquin de sa part de tenir des discours aussi hostiles.
L'hon. Herb Gray (vice-premier ministre, Lib.):
L'argumentation du depute ne tient tout simplement pas.
M. Stephane Bergeron (Vercheres, BQ):
Monsieur le President, ma question s'adresse au ministre des Ressources naturelles.
Certaines de ces sources relevent toujours du domaine du developpement scientifique.
Celle que mentionnait le depute entre dans cette categorie.
M. Stephane Bergeron (Vercheres, BQ):
M. Chuck Strahl (Fraser Valley, Ref.):
L'hon. Allan Rock (ministre de la Sante, Lib.):
Je rappelle de quoi il est question ici.
Le depute de Fraser Valley.
M. Chuck Strahl (Fraser Valley, Ref.):
L'hon. Allan Rock (ministre de la Sante, Lib.):
Monsieur le President, le rapport du juge Krever compte quatre volumes.
M. Maurice Dumas (Argenteuil-Papineau, BQ):
Mais on ne sait toujours pas ce que proposera le ministre.
L'hon. Jim Peterson (secretaire d'Etat (Institutions financieres internationales), Lib.):
Ces discussions continueront et il va prendre en consideration leur avis.
M. Roy Cullen (Etobicoke-Nord, Lib.):
Monsieur le President, ma question s'adresse a la secretaire d'Etat (Enfance et Jeunesse).
L'hon. Ethel Blondin-Andrew (secretaire d'Etat (Enfance et Jeunesse), Lib.):
Le depute de Calgary-Sud-Est.
M. Jason Kenney (Calgary-Sud-Est, Ref.):
Je pense que cela faciliterait quelque peu les choses pour nous tous.
La derniere fois que nous avons verifie, il y en avait trois.
Je me demande s'il les a lus, car les provinces l'ont certes fait.
Or, les provinces l'ont rouvert a nouveau.
Le ministre ignore tout de ce qui se passe.
Le ministre de la Sante.
L'hon. Allan Rock (ministre de la Sante, Lib.):
Monsieur le President, nous voyons maintenant ou est la source du probleme.
Les reformistes n'ont pas lu le quatrieme volume du rapport.
M. Jason Kenney (Calgary-Sud-Est, Ref.):
Ce n'est plus le cas des provinces.
L'hon. Herb Gray (vice-premier ministre, Lib.):
M. Pat Martin (Winnipeg-Centre, NPD):
C'est une question d'argent.
L'hon. Herb Gray (vice-premier ministre, Lib.):
N'y a-t-il pas eu un manque de principe la-dedans?
Ce n'est pas moi qui le dis, c'est lui.
M. Pat Martin (Winnipeg-Centre, NPD):
Monsieur le President, je pense que les Canadiens meritent une meilleure reponse que ca.
J'ai pose une question tout a fait legitime.
Nous savons tous que l'argent est la.
Si vous ne voulez pas rouvrir l'entente, au moins negociez...
Veuillez adresser vos questions a la presidence, s'il vous plait.
L'hon. Allan Rock (ministre de la Sante, Lib.):
C'est un principe important.
L'indemnisation doit etre reservee aux cas ou il y a eu faute.
C'est le principe que nous avons applique.
LA GENDARMERIE ROYALE DU CANADA
M. Peter MacKay (Pictou-Antigonish-Guysborough, PC):
Monsieur le President, cette affaire est close.
C'est un ministre qui a informe la GRC de ces allegations.
Une enquete complete a eu lieu.
Tous les faits ont ete presentes lors de l'enquete.
Une accusation a ete portee et l'individu a plaide coupable.
L'affaire est close.
M. Peter MacKay (Pictou-Antigonish-Guysborough, PC):
Il est fallacieux d'affirmer le contraire.
Quelles mesures le ministre a-t-il prises pour assurer aux Canadiens...
Monsieur le President, je le retire.
La question est presque antiparlementaire.
J'autoriserai le ministre a y repondre.
L'enquete dans ce dossier a eu lieu.
Tous les faits ont ete presentes a la GRC et l'affaire est close.
Mme Judi Longfield (Whitby-Ajax, Lib.):
L'hon. Hedy Fry (secretaire d'Etat (Multiculturalisme) (Situation de la femme), Lib.):
Le depute de Crowfoot.
M. Jack Ramsay (Crowfoot, Ref.):
Pourquoi refuse-t-il de le faire?
L'hon. Allan Rock (ministre de la Sante, Lib.):
Monsieur le President, premierement, il ne fait aucun doute que certains tests existaient avant 1986.
Certains Etats americains et pays d'Europe les appliquaient.
Auparavant, tout n'etait qu'hypothese et incertitude.
Le mois de janvier 1986 marque un point tournant.
Le depute de Charlesbourg.
LA GENDARMERIE ROYALE DU CANADA
M. Richard Marceau (Charlesbourg, BQ):
M. Nick Discepola (secretaire parlementaire du solliciteur general du Canada, Lib.):
M. Gordon Earle (Halifax-Ouest, NPD):
M. Bernard Patry (secretaire parlementaire du ministre des Affaires indiennes et du Nord canadien, Lib.):
M. Gerald Keddy (South Shore, PC):
Monsieur le President, ma question s'adresse au ministre de la Sante.
Deuxiemement, si le gouvernement manque d'argent, tant pis.
Nous avons tout de meme l'obligation...
Le ministre de la Sante a la parole.
L'hon. Allan Rock (ministre de la Sante, Lib.):
C'est pourquoi les gouvernements provinciaux et federal ont propose une indemnisation en especes.
Le depute de Calgary-Centre.
M. Eric Lowther (Calgary-Centre, Ref.):
Monsieur le President, les ministres provinciaux de la Sante font preuve de leadership.
Mais quelle reaction obtient-on en face?
Le moment est venu d'agir.
Nous demandons au premier ministre de se montrer vraiment responsable.
L'hon. Allan Rock (ministre de la Sante, Lib.):
Le depute appelle cela du leadership.
Le depute ne comprend pas cela, mais c'est precisement ce que fait le gouvernement.
La periode des questions est maintenant terminee.
REPONSE DU GOUVERNEMENT A DES PETITIONS
LES COMITES DE LA CHAMBRE
PROCEDURE ET AFFAIRES DE LA CHAMBRE
M. Guy St-Julien:
L'hon. Andy Scott (solliciteur general du Canada, Lib.):
b) La GRC n'a transige qu'avec Travaux publics et Services gouvernementaux Canada (TPSGC).
TPSGC a transige avec le proprietaire du terrain, Clair Foyer Inc.
Ce dernier donna son appui a cette initiative.
Le 14 octobre 1994, le maire de Val d'Or, M. Tetrault, fut egalement rencontre.
M. Guy St-Julien:
L'hon. Andy Scott (solliciteur general du Canada, Lib.):
b) La GRC a transige avec Travaux publics et Services gouvernementaux Canada (TPSGC).
M. Guy St-Julien:
L'hon. Andy Scott (solliciteur general du Canada, Lib.):
QUESTIONS TRANSFORMEES EN ORDRES DE DEPOT DE DOCUMENTS
Monsieur le President, je suggere que les autres questions soient reservees.
Monsieur le President, j'invoque le Reglement.
LOI SUR L'EDUCATION DES MI'KMAQ
Je l'invite donc a poursuivre.
M. Leon E. Benoit (Lakeland, Ref.):
Personnellement, j'aime bien la culture autochtone.
Nous savons que Phil Fontaine appuie le projet de loi.
Je voudrais une reponse a cette question.
Quel genre de comptabilite exigera-t-on?
Comment le verificateur sera-t-il choisi?
Il faut repondre a cette question.
C'est une question importante.
Il y avait 70 autochtones, dont sans doute 40 Indiens inscrits.
Que faut-il entendre exactement par autonomie gouvernementale?
Les autochtones de la base l'appuient-ils?
Ceux que nous avons entendu n'y sont certainement pas favorables.
Mon quatrieme point est en fait une observation.
Cela a ete exprime haut et clair.
Je ne pense pas vraiment avoir cette assurance maintenant.
Je demande egalement au gouvernement de repondre a mes questions.
Je conclurai en disant que le projet de loi laisse trop de questions sans reponse.
M. Lee Morrison (Cypress Hills-Grasslands, Ref.):
Monsieur le President, je ne veux pas aborder les dispositions particulieres du projet de loi.
D'autres deputes l'ont fait.
Il n'etait cependant pas un ministre influent au sein du gouvernement de l'epoque.
J'aimerais parler des pensionnats, dont la reputation a ete beaucoup rabaissee.
Ils avaient officiellement termine ce qui s'appelait alors la huitieme annee.
Je sais que les conditions etaient difficiles dans certains pensionnats.
Celui qu'ont frequente mes amis etait apparemment tres dur.
A l'epoque ou ils frequentaient ce pensionnat, toutes les ecoles etaient dures.
J'ai frequente une ecole ou les chatiments corporels etaient la norme.
Des evenements terribles ont eu lieu.
Ces gens sont a toutes fins utiles integres a la societe.
Le gouvernement propose ce que j'appellerais une politique de desintegration.
Ils l'ont trouve merveilleux et l'ont recopie chez eux.
Nous avons encore le systeme d'apartheid.
Nous avons encore les reserves.
Grace au ciel, elles sont un peu moins dures, mais a quel prix?
Nous avons cree cette gigantesque bureaucratie tant a Ottawa que dans les reserves.
Je ne peux donc pas en conscience appuyer un projet de loi de ce genre.
On a tort de diviser les gens.
C'est le vieux systeme colonial.
C'est comme cela qu'on faisait les choses a l'epoque coloniale.
M. Gordon Earle (Halifax-Ouest, NPD):
Je pense qu'on a utilise l'expression apprendre a se connaitre.
Il est temps de changer les choses et de faire face a la realite.
Soulignons que chaque chef represente sa communaute.
Le projet de loi C-30 permettrait le transfert des pouvoirs.
Cette idee n'est pas nouvelle.
A Eskasoni, des cours de langues sont donnes a l'ecole.
Tout cela donne des resultats positifs.
Le projet de loi C-30 mettra en oeuvre cette convention finale.
Une educatrice mi'kmaq, Marie Battiste, declarait:
La langue est le ciment et le lien.
Elle assure en quelque sorte la communion morale entre les membres d'une communaute.
J'ai moi-meme eprouve ce sentiment.
La Commission royale d'enquete recommandait, entre autres choses, que:
Ce projet de loi est un premier pas important dans cette direction.
Ils etaient devenus sages avec l'age.
C'etaient des autodidactes.
Beaucoup d'autochtones n'ont pas eu cette chance.
Tellement de gens ont peur du changement, de permettre aux gens de progresser.
Ce sont des details qui pourront etre regles a une autre tribune.
C'est le principe qui sous-tend le projet de loi qui importe.
Ils pourront a nouveau se montrer fiers de leur patrimoine.
Ils pourront controler leur destinee et leurs affaires.
Il n'y a rien a craindre de ce concept.
M. Lee Morrison (Cypress Hills-Grasslands, Ref.):
Et, si oui, pense-t-il que c'etait une bonne idee?
Monsieur le President, je vous felicite d'avoir indique que ma circonscription etait Halifax-Ouest.
Ce n'est pas St. John's-Est, comme l'a dit le depute.
En utilisant cette terminologie, on exclut et on isole les autochtones.
Les autochtones font partie de la societe canadienne.
Il n'y a rien de mal a cela.
A l'heure actuelle, il existe beaucoup de systemes differents.
Il y a l'enseignement a distance par ordinateur.
Ce n'est pas contradictoire.
Je dois dire au depute que je ne comprends pas son argument.
M. Gerald Keddy (South Shore, PC):
Il est connu du public depuis sept ans deja.
Ce n'est pas la premiere fois que le public en entend parler.
Neuf desPremieres Nations Mi'kmaq ont signe la convention le 14 fevrier 1997.
L'inverse peut aussi se produire.
Ces deux procedures entreraient en vigueur le 1 er avril de l'annee suivante.
Cette loi s'applique a toutes lesPremieres Nations mi'kmaq.
Les avantages de cette mesure legislative sont donc minimes pour ce groupe.
Au Canada, il y a actuellement 27Premieres Nations mi'kmaq.
Elles ont une longue histoire et une solide culture.
La Loi sur les Indiens confere ce pouvoir au gouvernement federal.
Chaque communaute devra d'abord se donner une Constitution avant d'elaborer ses lois.
C'est un domaine extremement important pour les Premieres Nations et leurs etudiants.
C'est une mesure legislative historique.
J'ai hate de l'examiner plus en detail, au comite.
LES COMITES DE LA CHAMBRE
LOI SUR L'EDUCATION DES MI'KMAQ.
La Chambre est-elle prete a se prononcer?
La question porte sur la motion.
Plait-il a la Chambre d'adopter la motion?
Que tous ceux qui sont en faveur de la motion veuillent bien dire oui.
Que tous ceux qui sont contre veuillent bien dire non.
A mon avis, les oui l'emportent.
Et plus de cinq deputes s'etant leves:
La peine minimale s'applique toujours, meme dans le cas des tueurs les plus prolifiques.
Nous ne prevoyons pas de peines concurrentes pour des billets de stationnement.
Si on stationne dix fois de facon illegale, on paye dix contraventions.
Il n'y a pas de ristourne.
L'imposition de peines concurrentes va clairement a l'encontre de chacun de ces principes.
Wendy Carroll m'a ecrit apres avoir survecu de justesse a ces predateurs.
A quoi pensent-ils?
Le projet de loi ne demande pas a la commission d'etre moins irresponsable.
Il n'alourdit la peine d'aucun crime.
Il pourrait ainsi profiter au maximum de la concomitance des peines.
Olson a nargue le tribunal: Ils ne peuvent rien faire.
Ils ne peuvent donner que des peines concurrentes.
Tous pourront encore purger des peines concurrentes, sauf les pires criminels.
J'invite les deputes a faire preuve de compassion la ou cela se justifie.
Je ne ris pas.
Malheureusement, c'est l'argument que certains deputes ont soutenu a la Chambre.
Les Canadiens commencent a comprendre ce que signifie reellement l'emprisonnement a perpetuite.
Malheureusement, le cas de Denis Lortie n'a rien d'exceptionnel.
Mais, en apparence, nous restons magnanimes.
Nous savons que chaque predateur en serie condamne est capable de crimes horribles.
Si un jouet pour enfants avait ce dossier, il serait interdit.
Je ne vous ai jamais vu comme une menace.
Je me preoccupais plus de votre securite que de la mienne.
Des detenus vous consultent.
Vous leur donnez des avis.
Vous les aidez a preparer des documents et vous etes bien vu par eux.
D'abord, vous lisez beaucoup.
Vous me tenez au courant de l'actualite.
L'industrie de protection des predateurs utilise souvent ce genre d'hyperbole.
L'emprisonnement a perpetuite n'est pas une forme de vengeance.
Bref, il voulait preserver le silence des agneaux.
En revanche, c'est l'industrie de la protection des predateurs qu'on favorise.
Laissez-moi resumer les arguments en faveur des rabais pour les violeurs et les meurtriers.
Ce qui importe le plus, nous ne voulons pas creer une industries des victimes.
M. Jack Ramsay (Crowfoot, Ref.):
On les a encourages en secret.
En 1986, la deputee aurait dit, selon le Hill Times :
Mme Mahaffy poursuit en ces termes:
Il est intitule Une ministre de la Justice aussi visible qu'une marmotte en hiver.
C'est toutefois ce qui s'est produit.
Voici donc cet article:
Ottawa fut un echec pour le depute de Surrey-Nord.
J'ai parle pendant tout au plus cinq minutes, dit-il.
Je n'aurais meme pas du me donner la peine d'y aller.
Il s'est egalement plaint que la seance etait mal dirigee.
[Le depute de Surrey-Nord] a indique que tout tournait autour des droits des criminels.
Mais aucun n'a ete adopte.
Cette mesure legislative indispensable n'a pas force de loi.
M. Gordon Earle (Halifax-Ouest, NPD):
Ce projet de loi d'initiative parlementaire a deux elements principaux.
Au Canada, la determination de la peine est quelque chose d'assez complexe.
Le degre de la peine est fixe par l'article 718.3.
Les peines concurrentes sont purgees en meme temps.
Les peines consecutives sont cumulatives.
C'est un principe de common law qui est consacre dans le droit.
Voila pourquoi nous ne pouvons pas appuyer le projet de loi sous sa forme actuelle.
M. Peter MacKay (Pictou-Antigonish-Guysborough, PC):
Le predecesseur du projet de loi a l'etude portait alors le numero C-321.
Je la felicite pour son travail.
Ces propositions de la deputee sont significatives pour toute la collectivite.
Le projet de loi C-251 prevoit l'imposition de sentences reelles, une chose indispensable.
Les principes de determination de la peine sont etablis dans le Code criminel du Canada.
Essayez d'expliquer cela aux victimes.
Il faut reexaminer les principes de determination de la peine.
La suggestion du depute a ce sujet est excellente.
Personne ne devrait pouvoir s'en tirer a bon compte dans notre systeme de justice.
Malheureusement, c'est justement ce qui se produit a l'occasion.
C'est tout a fait absurde.
Il devrait purger 11 peines d'emprisonnement a perpetuite.
Il faut tout de meme faire preuve de bon sens.
Les condamnations avec sursis constituent une autre question qu'il convient de revoir.
Le projet de loi C-251 touche a ces questions.
Il touche a l'essence de ce probleme et fait preuve de bon sens.
J'apporte donc mon soutien a la deputee et a son projet de loi.
Je reconnais l'importance de la coherence dans les sentences.
Ainsi, le delinquant et la societe pourraient prendre leur systeme de justice au serieux.
C'est la une excellente suggestion de la deputee.
Une personne capable de violence grave et d'agressions sexuelles violentes presente un risque.
Ce probleme doit etre prioritaire.
Nous devons etre prets a agir.
Le projet de loi a l'etude merite notre appui.
Il faut faire encore plus.
Il faut continuer de travailler pour atteindre cet objectif important.
M. Nick Discepola (secretaire parlementaire du solliciteur general du Canada, Lib.):
Dans tous les cas, ces milieux ont ete consultes.
Les choses changent rapidement de nos jours.
Notre systeme de justice penale est-il efficace?
Protege-t-il nos citoyens les plus vulnerables?
Ce sont toutes des questions qu'il vaut la peine de se poser.
Nous devons toutefois tenir compte du fait que le paysage a change.
J'invite la deputee a faire ses recommandations, conformement a cet examen exhaustif.
Au comite en question, je collaborerai avec la deputee.
M. Ken Epp (Elk Island, Ref.):
Je dois me censurer, car mes propos seraient antiparlementaires.
C'est different de la sympathie.
Avoir de l'empathie pour une personne, c'est ressentir la meme chose qu'elle.
Cette personne, c'est Eugene Martens.
Il n'a pas ete victime d'un conducteur dont les facultes etaient affaiblies.
C'etait un accident.
Je n'arrive pas a comprendre comment cela se peut.
Il suffit pourtant d'essayer de se mettre a la place de l'autre.
Nous parlons de modifier les regles relatives aux peines.
C'est deraisonnable de permettre les peines concurrentes.
Au pire, il faut que ce soit au moins 25 ans.
(La seance est levee a 13 h 55.)


program test_version
!! tests that NetCDF4 library version is available

use nc4fortran, only : nc4version

implicit none (type, external)

character(24) :: vstr, v
character(:), allocatable :: libver, compver
integer :: i

v = nc4version()

print '(A)', v

if(command_argument_count() < 1) stop

call get_command_argument(1, vstr, status=i)
if (i/=0) error stop "input version string to compare"

compver = get_version_mmr(vstr)
libver = get_version_mmr(v)
if (compver /= libver) error stop "version mismatch: " // compver // " /= " // libver

contains

pure function get_version_mmr(v)
!! get the major.minor.release part of a version string
!! cuts off further patch and arbitrary text
character(:), allocatable :: get_version_mmr
character(*), intent(in) :: v

integer :: i, j, k, e

k = index(v, '.')
j = index(v(k+1:), '.')
i = scan(v(k+j+1:), '.-_ ')
if (i == 0) then
  e = len_trim(v)
else
  e = k + j + i - 1
end if

get_version_mmr = v(:e)

end function get_version_mmr

end program


text:
cdis    Forecast Systems Laboratory
cdis    NOAA/OAR/ERL/FSL
cdis    325 Broadway
cdis    Boulder, CO     80303
cdis
cdis    Forecast Research Division
cdis    Local Analysis and Prediction Branch
cdis    LAPS
cdis
cdis    This software and its documentation are in the public domain and
cdis    are furnished "as is."  The United States government, its
cdis    instrumentalities, officers, employees, and agents make no
cdis    warranty, express or implied, as to the usefulness of the software
cdis    and documentation for any purpose.  They assume no responsibility
cdis    (1) for the use of the software and documentation; or (2) to provide
cdis     technical support to users.
cdis
cdis    Permission to use, copy, modify, and distribute this software is
cdis    hereby granted, provided that the entire disclaimer notice appears
cdis    in all copies.  All modifications to this software must be clearly
cdis    documented, and are solely the responsibility of the agent making
cdis    the modifications.  If significant modifications or enhancements
cdis    are made to this software, the FSL Software Policy Manager
cdis    (softwaremgr@fsl.noaa.gov) should be notified.
cdis
cdis
cdis
cdis
cdis
cdis
cdis

        subroutine get_laps_2d(i4time,EXT,var_2d,units_2d,
     1                  comment_2d,imax,jmax,field_2d,istatus)

cdoc    Used to read in a surface grid with inputs of time and ext

        character*9 asc9_tim
        character*150 DIRECTORY
        character*(*) EXT

        character*125 comment_2d
        character*10 units_2d
        character*3 var_2d
        integer LVL_2d
        character*4 LVL_COORD_2d

        real field_2d(imax,jmax)

        call get_r_missing_data(r_missing_data,istatus)
        if(istatus .ne. 1)then
            write(6,*)' get_laps_2d: bad istatus, return'
            return
        endif

        call get_directory(ext,directory,len_dir)

        call make_fnam_lp(i4time,asc9_tim,istatus)

        write(6,11)trim(directory),asc9_tim,ext,var_2d
11      format(' Reading 2d ',a,1x,a,1x,a,1x,a)

        lvl_2d = 0
        lvl_coord_2d = 'MSL'

        CALL READ_LAPS_DATA(I4TIME,DIRECTORY,EXT,imax,jmax,
     1  1,1,VAR_2D,LVL_2D,LVL_COORD_2D,UNITS_2D,
     1                     COMMENT_2D,field_2d,ISTATUS)

!       Check for missing data
        do j = 1,jmax
        do i = 1,imax
            if(istatus .eq. 1)then
                if(field_2d(i,j) .eq. r_missing_data)then
                    write(6,*)' Missing Data Value Detected in 2D Field'
                    istatus = -1
                endif
            endif
        enddo ! i
        enddo ! j

        return
        end

        subroutine get_lapsdata_2d(i4time,i4_valid,EXT
     1,var_2d,units_2d,comment_2d,imax,jmax,field_2d,istatus)

!       Returns a 2D laps grid
!       i4time              Input      Desired i4time initial
!       i4_valid            Input      i4time for valid data time
!       ext                 Input      3 character file extension
!       var_2d              Input      Which Variable do you want?
!       units_2d            Output     Units of data
!       Comment_2d          Output     Comment block
!       imax,jmax           Input      LAPS grid dimensions
!       field_2d            Output     2D grid
!       istatus             Output     status

!       Steve Albers            1996

cdoc    This routine can be used to read in a surface grid of known time
cdoc    by calling the new READ_LAPS routine

        include      'bgdata.inc'

        character*9 asc9_tim
        character*150 DIRECTORY
        character*(*) EXT
        character*31  EXT_INT

        character*125 comment_2d
        character*10 units_2d
        character*15 fdda_model_source(maxbgmodels)
        character*3 var_2d
        integer   LVL_2d
        integer   nfdda
        character*4 LVL_COORD_2d

        real field_2d(imax,jmax)

        call get_r_missing_data(r_missing_data,istatus)
        if(istatus .ne. 1)then
            write(6,*)' get_lapsdata_2d: bad istatus, return'
            return
        endif

c       call get_fdda_model_source(fdda_model_source,nfdda,istatus)

        call s_len(ext,len)

        if(len.gt.3)then
           directory = ext
           call s_len(directory,len_dir)
c
c code section below needs more when we reverse the fdda subdirectory
c order (ie., from fsf/"model" to "model"/fsf)
c
           if(directory(len_dir:len_dir).eq.'/')then
              len_dir=len_dir-1
              directory=directory(1:len_dir)
           endif
           call get_directory_length(directory,len)
           if(directory(len+1:len_dir).eq.'lgb')then
              ext_int='lgb'

           else ! maybe fsf (determine extension from directory name)

c             do l=1,nfdda
c                if(directory(len+1:len_dir).eq.
c    &fdda_model_source(l))then

              mark=0
              search_dir: do l=len_dir-1,1,-1
                 if(directory(l:l).eq.'/')then
                    mark=l
                    exit search_dir
                 endif
              enddo search_dir

              ext_int=directory(mark-3:mark-1)

c                endif
c             enddo
           endif ! directory is lgb

c          if(ext_int.eq.' ')then
c             print*,'Unknown lapsprd extension'
c    &,directory(1:len_dir)
c             istatus = 0
c             return
c          endif

           len=3
           len_dir=len_dir+1
           directory(len_dir:len_dir)='/'
        else
           call get_directory(ext,directory,len_dir)
           ext_int=ext
        endif

        call make_fnam_lp(i4time,asc9_tim,istatus)

        write(6,11)trim(directory),ext_int(1:len),var_2d
11      format(' Reading 2d ',a,1x,a5,1x,a3)

        lvl_2d = 0
        lvl_coord_2d = 'MSL'

        CALL READ_LAPS(I4TIME,i4_valid,DIRECTORY,EXT_INT
     1,imax,jmax,1,1,VAR_2D,LVL_2D,LVL_COORD_2D,UNITS_2D
     1, COMMENT_2D,field_2d,ISTATUS)

!       Check for missing data
        do j = 1,jmax
        do i = 1,imax
            if(istatus .eq. 1)then
                if(field_2d(i,j) .eq. r_missing_data)then
                    write(6,*)' Missing Data Value Detected in 2D Field'
                    istatus = -1
                endif
            endif
        enddo ! i
        enddo ! j

        return
        end

        subroutine get_laps_2dgrid(i4time_needed,i4tol,i4time_nearest
     1         ,ext_in,var_2d,units_2d
     1         ,comment_2d,imax,jmax,field_2d,ilevel,istatus)

cdoc    Returns a 2-D grid. Inputs include the extension and time window.

        character*9 asc9_tim

        character*150 DIRECTORY
        character*(*) EXT_IN
        character*31 ext

        character*125 comment_2d
        character*10 units_2d
        character*3 var_2d
        integer LVL_2d
        character*4 LVL_COORD_2d

        real field_2d(imax,jmax)

        character*255 c_filespec

        logical ltest_vertical_grid

        call get_r_missing_data(r_missing_data,istatus)
        if(istatus .ne. 1)then
            write(6,*)' get_laps_2dgrid: bad istatus, return'
            return
        endif

        call get_directory(ext_in,directory,len_dir)

        if(ext_in .eq. 'balance')then
            directory = directory(1:len_dir)//'lsx/'
            len_dir = len_dir + 4
            ext = 'lsx'
        else
            ext = ext_in
        endif

        call s_len(ext,lenext)

        c_filespec = directory(1:len_dir)//'*.'//ext(1:lenext)
        call get_file_time(c_filespec,i4time_needed,i4time_nearest)

        if(abs(i4time_needed - i4time_nearest) .le. i4tol)then
            if(ilevel .ne. 0)then
                if(ltest_vertical_grid('HEIGHT'))then
                    lvl_2d = zcoord_of_level(k)/10
                    lvl_coord_2d = 'MSL'
                elseif(ltest_vertical_grid('PRESSURE'))then
                    lvl_2d = ilevel
                    lvl_coord_2d = 'MB'
                elseif(var_2d .eq. 'LSM' .and. ilevel .ge. -3
     1                                   .and. ilevel .le. -1)then
                    lvl_2d = ilevel
                    lvl_coord_2d = 'HPA'
                else
                    write(6,*)' Error, vertical grid not supported,'
     1                      ,' this routine supports PRESSURE or HEIGHT'
                    istatus = 0
                    return
                endif

            else
                lvl_2d = 0
                lvl_coord_2d = 'MSL'

            endif

            call make_fnam_lp(i4time_nearest,asc9_tim,istatus)

            write(6,11)trim(directory),asc9_tim,ext(1:5),var_2d
11          format(' Reading 2d ',a,1x,a9,1x,a5,1x,a3)

            CALL READ_LAPS_DATA(I4TIME_nearest,DIRECTORY,EXT,imax,jmax,
     1                     1,1,VAR_2D,LVL_2D,LVL_COORD_2D,UNITS_2D,
     1                     COMMENT_2D,field_2d,ISTATUS)

!           Check for missing data
            do j = 1,jmax
            do i = 1,imax
            if(istatus .eq. 1)then
                if(field_2d(i,j) .eq. r_missing_data)then
                    write(6,*)' Missing Data Value Detected in 2D Field'
                    istatus = -1
                endif
            endif
            enddo ! i
            enddo ! j

        else
            write(6,*)' No field found within window ',ext(1:10)
            istatus = 0

        endif

        return
        end
c
        subroutine get_2dgrid_dname(directory
     1         ,i4time_needed,i4tol,i4time_nearest
     1         ,EXT,var_2d,units_2d
     1         ,comment_2d,imax,jmax,field_2d,ilevel,istatus)

cdoc    Returns a 2-D grid. Inputs include the directory, ext, and time window.

!       Steve Albers            1990
!           J Smart             1998

        character*9 asc9_tim

        character*150 DIRECTORY
        character*(*) EXT

        character*125 comment_2d
        character*10 units_2d
        character*3 var_2d
        integer LVL_2d
        character*4 LVL_COORD_2d

        real field_2d(imax,jmax)

        character*255 c_filespec

        logical ltest_vertical_grid

        call get_r_missing_data(r_missing_data,istatus)
        if(istatus .ne. 1)then
            write(6,*)' get_2dgrid_dname: bad istatus, return'
            return
        endif

        do i = 1,31
            if(ext(i:i) .eq. ' ')goto20
        enddo
20      lenext = i-1

        len_dir=index(directory,' ')-1
        c_filespec = directory(1:len_dir)//'*.'//ext(1:lenext)
        call get_file_time(c_filespec,i4time_needed,i4time_nearest)

        if(abs(i4time_needed - i4time_nearest) .le. i4tol)then
            if(ilevel .ne. 0)then
                if(ltest_vertical_grid('HEIGHT'))then
                    lvl_2d = zcoord_of_level(k)/10
                    lvl_coord_2d = 'MSL'
                elseif(ltest_vertical_grid('PRESSURE'))then
                    lvl_2d = ilevel
                    lvl_coord_2d = 'MB'
                else
                    write(6,*)' Error, vertical grid not supported,'
     1                      ,' this routine supports PRESSURE or HEIGHT'
                    istatus = 0
                    return
                endif

            else
                lvl_2d = 0
                lvl_coord_2d = 'MSL'

            endif

            call make_fnam_lp(i4time_nearest,asc9_tim,istatus)

            write(6,11)trim(directory),asc9_tim,ext(1:5),var_2d
11          format(' Reading 2d ',a,1x,a9,1x,a5,1x,a3)

            CALL READ_LAPS_DATA(I4TIME_nearest,DIRECTORY,EXT,imax,jmax,
     1                     1,1,VAR_2D,LVL_2D,LVL_COORD_2D,UNITS_2D,
     1                     COMMENT_2D,field_2d,ISTATUS)

!           Check for missing data
            do j = 1,jmax
            do i = 1,imax
            if(istatus .eq. 1)then
                if(field_2d(i,j) .eq. r_missing_data)then
                    write(6,*)' Missing Data Value Detected in 2D Field'
                    istatus = -1
                endif
            endif
            enddo ! i
            enddo ! j

        else
            write(6,*)' No field found within window ',ext(1:10)
            istatus = 0

        endif

        return
        end

        subroutine get_laps_2dvar(i4time_needed,i4tol,i4time_nearest
     1         ,lat,lon
     1         ,subpoint_lat_clo,subpoint_lon_clo      ! O
     1         ,EXT,var_2d,units_2d
     1         ,comment_2d,imax,jmax,field_2d,ilevel,istatus)

!       Steve Albers            1996
cdoc    This routine tries to read in the desired variable from all files
cdoc    having the proper extension, picking the closest one within the
cdoc    specified time window.
!
!       J Smart                 1998
cdoc    added lvd subdirectory flexibility. Only one 2d satellite field returned.

!       Steve Albers            2011
!       Pass in lat/lon so that it can potentally be used for satellite mosaicing

        character*9 asc9_tim

        character*150 DIRECTORY
        character*(*) EXT

        character*125 comment_2d
        character*10 units_2d
        character*3 var_2d
        integer LVL_2d
        character*4 LVL_COORD_2d

        real field_2d(imax,jmax)
        real lat(imax,jmax)
        real lon(imax,jmax)

        integer max_files
        parameter (max_files = 20000)
        character*255 c_filespec
        character*120 c_fnames(max_files)
        integer i4times(max_files)
        integer i_selected(max_files)

        real    subpoint_lat_clo(imax,jmax)
        real    subpoint_lon_clo(imax,jmax)

        include 'satellite_dims_lvd.inc'
        include 'satellite_common_lvd.inc'

        logical ltest_vertical_grid

        call get_r_missing_data(r_missing_data,istatus)
        if(istatus .ne. 1)then
            write(6,*)' get_laps_2dvar: bad istatus, return'
            return
        endif

        do i = 1,31
            if(ext(i:i) .eq. ' ')goto20
        enddo
20      lenext = i-1

c
c lvd switch
c
        if(ext(1:lenext).eq.'lvd')then
           call config_satellite_lvd(istatus)
           if(istatus.ne.1)then
              return
           endif

           call get_laps_sat(maxsat,c_sat_id,isats
     1     ,i4time_needed,i4tol,i4time_nearest
     1     ,var_2d,units_2d,comment_2d,imax,jmax
     1     ,subpoint_lat_clo,subpoint_lon_clo      ! O
     1     ,lat,lon,field_2d,istatus)

           if(istatus.ne.1)then
              write(6,*)'No data returned from get_laps_sat'
              return
           else
              return
           endif
        endif

        call get_directory(ext,directory,len_dir)

        do i = 1,max_files
            i_selected(i) = 0
        enddo ! i

        c_filespec = directory(1:len_dir)//'*.'//ext(1:lenext)

        call get_file_times(c_filespec,max_files,c_fnames
     1                      ,i4times,i_nbr_files_ret,istatus)
        if(istatus .ne. 1)then
            write(6,*)'get_laps_2dvar: Bad status returned '
     1               ,'from get_file_times'
            return
        endif

50      i4_diff_min = 999999999
        do i = 1,i_nbr_files_ret
            i4_diff = abs(i4times(i) - i4time_needed)
            if(i_selected(i) .eq. 0)then
                i4_diff_min = min(i4_diff,i4_diff_min)
            endif
        enddo ! i

        if(i4_diff_min .gt. i4tol)then
            write(6,*)' No remaining files found within ',i4tol
     1               ,' sec time window ',ext(1:5),var_2d
            istatus = 0
            return
        endif

        do i = 1,i_nbr_files_ret
            i4_diff = abs(i4times(i) - i4time_needed)
            if(i4_diff .eq. i4_diff_min .and. i_selected(i) .eq. 0)then
                i_selected(i) = 1

                if(ilevel .ne. 0)then
                    if(ltest_vertical_grid('HEIGHT'))then
                        lvl_2d = zcoord_of_level(k)/10
                        lvl_coord_2d = 'MSL'
                    elseif(ltest_vertical_grid('PRESSURE'))then
                        lvl_2d = ilevel
                        lvl_coord_2d = 'MB'
                    else
                        write(6,*)' Error, vertical grid not supported,'
     1                      ,' this routine supports PRESSURE or HEIGHT'
                        istatus = 0
                        return
                    endif

                else
                    lvl_2d = 0
                    lvl_coord_2d = 'MSL'

                endif

                call make_fnam_lp(i4times(i),asc9_tim,istatus)

                write(6,11)trim(directory),asc9_tim,ext(1:5),var_2d
11              format(' Reading 2d ',a,1x,a9,1x,a5,1x,a3)

                CALL READ_LAPS_DATA(i4times(i),DIRECTORY,EXT,imax
     1            ,jmax,1,1,VAR_2D,LVL_2D,LVL_COORD_2D,UNITS_2D
     1            ,COMMENT_2D,field_2d,ISTATUS)

                if(istatus .ne. 1)then
                    write(6,*)' No field found at ',ext(1:10)
     1                       ,var_2d,' ',asc9_tim
                    go to 50

                else   !  istatus = 1, check for missing data
                    do il = 1,imax
                    do jl = 1,jmax
                        if(field_2d(il,jl) .eq. r_missing_data)then
                            write(6,*)il,jl,
     1                        ' Missing Data Value Detected in 2D Field'
                            istatus = -1
                            return
                        endif
                    enddo ! j
                    enddo ! i

                endif

                return ! istatus = 1 and no missing data

            endif ! File is closest unread file to desired time
        enddo ! ith file

        end

        subroutine get_laps_3d(i4time,imax,jmax,kmax
     1  ,EXT,var_2d,units_2d,comment_2d,field_3d,istatus)

cdoc    Returns a 3-D grid. Inputs include the extension and time.

!       i4time              Input      Desired i4time
!       imax,jmax,kmax      Input      LAPS grid dimensions
!       ext                 Input      3 character file extension
!       var_2d              Input      Which Variable do you want?
!       units_2d            Output     Units of data
!       Comment_2d          Output     Comment block
!       field_3d            Output     3D grid

!       Steve Albers            1990

        character*150 DIRECTORY
        character*(*) EXT, var_2d

        character*125 comment_3d(kmax),comment_2d
        character*10 units_3d(kmax),units_2d
        character*3 var_3d(kmax)
        integer LVL_3d(kmax)
        character*4 LVL_COORD_3d(kmax)

        real field_3d(imax,jmax,kmax)

        write(6,*)' Subroutine get_laps_3d...'

        call get_directory(ext,directory,len_dir)

        call get_3d_dir_time(directory,i4time
     1                      ,EXT,var_2d,units_2d
     1                      ,comment_2d
     1                      ,imax,jmax,kmax,field_3d,istatus)

        return
        end

        subroutine get_lapsdata_3d(i4time,i4_valid
     1,imax,jmax,kmax,EXT,var_2d,units_2d,comment_2d
     1,field_3d,istatus)

cdoc    Returns a 3-D fcst grid. Inputs include directory, initial and valid time.

!       i4time              Input      Desired i4time initial
!       i4_valid            Input      i4time for valid data time
!       imax,jmax,kmax      Input      LAPS grid dimensions
!       ext                 Input      3 character file extension or model member
!       var_2d              Input      Which Variable do you want?
!       units_2d            Output     Units of data
!       Comment_2d          Output     Comment block
!       field_3d            Output     3D grid

!       Steve Albers            1990

        use mem_namelist, ONLY: lvl_coord_cdf

        include      'bgdata.inc'

        character*150 DIRECTORY
        character*(*) EXT
        character*31  EXT_INT

        character*125 comment_3d(kmax),comment_2d
        character*10 units_3d(kmax),units_2d
        character*15 fdda_model_source(maxbgmodels)
        character*3  var_3d(kmax),var_2d

        integer     LVL_3d(kmax)
        integer     nfdda,l
        character*4 LVL_COORD_3d(kmax)

        real field_3d(imax,jmax,kmax)
        real sigma_1d(kmax)
        real ht_1d(kmax)

        logical ltest_vertical_grid

        call get_fdda_model_source(fdda_model_source,nfdda,istatus)

        call s_len(ext,len)
        if(len.gt.3)then    !this tests whether ext is truely an extension or not.
           directory = ext
           call s_len(directory,len_dir)
c
c code section below needs more when we reverse the fdda subdirectory
c order (ie., from fsf/"model" to "model"/fsf)
c
           if(directory(len_dir:len_dir).eq.'/')then
              len_dir=len_dir-1
              directory=directory(1:len_dir)
           endif
           call get_directory_length(directory,len)
           if(directory(len+1:len_dir).eq.'lga')then
              ext_int='lga'
           else

c             do l=1,nfdda
c                if(directory(len+1:len_dir).eq.
c    &fdda_model_source(l))then

                    ext_int='fua'

c                endif
c             enddo

           endif
c          if(ext_int.eq.' ')then
c             print*,'Unknown lapsprd extension'
c    &,directory(1:len_dir)
c             istatus = 0
c             return
c          endif

           len=3
           len_dir=len_dir+1
           directory(len_dir:len_dir)='/'
        else
           call get_directory(ext,directory,len_dir)
           ext_int=ext
        endif

        write(6,11)directory(1:len_dir),ext_int(1:len)
     1,var_2d
11      format(' Reading 3d ',a,1x,a5,1x,a3)

        if(kmax.gt.1)then
          do k = 1,kmax
            units_3d(k)   = units_2d
            if(ltest_vertical_grid('HEIGHT'))then
                lvl_3d(k) = zcoord_of_level(k)/10
                lvl_coord_3d(k) = 'MSL'
            elseif(ltest_vertical_grid('PRESSURE'))then
                if(lvl_coord_cdf(1:3) .eq. 'HPA')then
                    lvl_3d(k) = nint(zcoord_of_level(k))/100
                    lvl_coord_3d(k) = 'MB' ! informational
                elseif(lvl_coord_cdf(1:3) .eq. 'PA')then
                    lvl_3d(k) = nint(zcoord_of_level(k))
                    lvl_coord_3d(k) = 'PA' ! informational
                else
                    write(6,*)
     1               ' Error, pressure units not supported '
     1               ,lvl_coord_cdf
                    istatus = 0
                    return
                endif
            elseif(ltest_vertical_grid('SIGMA_P'))then
                if(k .eq. 1)then
                    write(6,*)' Reading Sigma P Levels'
                    call get_sigma_1d(kmax,sigma_1d,istatus)
                    if(istatus .ne. 1)then
                        return
                    endif
                endif

                lvl_3d(k) = nint(sigma_1d(k) * 1000.)
                lvl_coord_3d(k) = '  ' ! informational
            elseif(ltest_vertical_grid('SIGMA_HT'))then
                if(k .eq. 1)then
                    write(6,*)' Reading Sigma Ht Levels'
                    call get_ht_1d(kmax,ht_1d,istatus)
                    if(istatus .ne. 1)then
                        return
                    endif
                endif

                lvl_3d(k) = nint(ht_1d(k))
                lvl_coord_3d(k) = '  ' ! informational
            else
                write(6,*)' Error, vertical grid not supported,'
     1                   ,' in subroutine get_lapsdata_3d'
                istatus = 0
                return
            endif

            var_3d(k) = var_2d

          enddo ! k

          CALL READ_LAPS(I4TIME,I4_VALID,DIRECTORY,EXT_INT,imax,jmax,
     1  kmax,kmax,VAR_3D,LVL_3D,LVL_COORD_3D,UNITS_3D,
     1                     COMMENT_3D,field_3d,ISTATUS)

          comment_2d=comment_3d(1)
          units_2d=units_3d(1)

        else

          CALL READ_LAPS(I4TIME,i4_valid,DIRECTORY,EXT_INT
     1,imax,jmax,1,1,VAR_3D,LVL_3D,LVL_COORD_3D,UNITS_2D
     1, COMMENT_2D,field_3d,ISTATUS)

        endif
        return
        end

        subroutine get_laps_3dgrid(i4time_needed,i4tol,i4time_nearest,
     1          imax,jmax,kmax,EXT,var_2d,units_2d,
     1                          comment_2d,field_3d,istatus)

cdoc    Returns a 3-D analysis grid. Inputs include the extension and time window.

!       i4time_needed       Input      Desired i4time
!       i4tol               Input      Tolerance of accepted file times
!       i4time_nearest      Output     Actual File time of returned data
!       imax,jmax,kmax      Input      LAPS grid dimensions
!       var_2d              Input      Which Variable Do you Want?
!       ext                 Input      3 character file extension
!       units_2d            Output     Units of data
!       Comment_2d          Output     Comment block
!       field_3d            Output     3D grid

!       Steve Albers            1990

        character*150 DIRECTORY
        character*(*) EXT

        character*125 comment_2d
        character*10 units_2d
        character*3 var_2d

        real field_3d(imax,jmax,kmax)

        character*255 c_filespec

        call get_directory(ext,directory,len_dir)

        call s_len(ext,lenext)

        c_filespec = directory(1:len_dir)//'*.'//ext(1:lenext)
        call get_file_time(c_filespec,i4time_needed,i4time_nearest)

        if(abs(i4time_needed - i4time_nearest) .le. i4tol)then
            call get_laps_3d(i4time_nearest,imax,jmax,kmax
     1                  ,EXT,var_2d,units_2d,
     1                          comment_2d,field_3d,istatus)
        else
            write(6,*)' No field found within window ',ext(1:10)
            istatus = 0
        endif

        return
        end

        subroutine put_laps_2d(i4time,EXT,var_2d,units_2d,
     1                  comment_2d,imax,jmax,field_2d,istatus)

cdoc    Writes a 2-D grid. Inputs include the extension and time.

        character*150 DIRECTORY
cc        character*31 EXT
        character*(*) EXT

        character*125 comment_2d
        character*10 units_2d
cc        character*3 var_2d
        character*(*) var_2d
        integer LVL_2d
        character*4 LVL_COORD_2d

        real field_2d(imax,jmax)

        call get_directory(ext,directory,len_dir)

        call s_len(ext,len_ext)

        write(6,11)directory(1:len_dir),ext(1:len_ext),var_2d
11      format(' Writing 2d ',a,1x,a,1x,a)

        call check_nan2(field_2d,imax,jmax,istatus)
        if(istatus .ne. 1)then
            write(6,*)' ERROR: Nan Detected in this 2D field'
            return
        endif

        lvl_2d = 0
        lvl_coord_2d = 'MSL'

        CALL WRITE_LAPS_DATA(I4TIME,DIRECTORY,EXT,imax,jmax,
     1  1,1,VAR_2D,LVL_2D,LVL_COORD_2D,UNITS_2D,
     1                     COMMENT_2D,field_2d,ISTATUS)

        return
        end

        subroutine put_laps_3d(i4time,EXT,var_2d,units_2d,
     1                          comment_2d,field_3d,ni,nj,nk)

cdoc    Writes a 3-D grid. Inputs include the extension and time.

        logical ltest_vertical_grid

        character*150 DIRECTORY
        character*(*) EXT

        character*125 comment_3d(nk),comment_2d
        character*10 units_3d(nk),units_2d
        character*3 var_3d(nk),var_2d
        integer LVL_3d(nk)
        character*4 LVL_COORD_3d(nk)
        real ht_1d(nk)

        real field_3d(ni,nj,nk)

        call get_directory(ext,directory,len_dir)

        write(6,11)directory(1:min(len_dir,50)),ext,var_2d
11      format(' Writing 3d ',a50,1x,a5,1x,a3)

        do k = 1,nk
            units_3d(k)   = units_2d
            comment_3d(k) = comment_2d
            if(ltest_vertical_grid('HEIGHT'))then
                lvl_3d(k) = zcoord_of_level(k)/10
                lvl_coord_3d(k) = 'MSL'
            elseif(ltest_vertical_grid('PRESSURE'))then
                lvl_3d(k) = nint(zcoord_of_level(k))/100
                lvl_coord_3d(k) = 'HPA'
            elseif(ltest_vertical_grid('SIGMA_HT'))then
                if(k .eq. 1)then
                    write(6,*)' Reading Sigma Ht Levels'
                    call get_ht_1d(nk,ht_1d,istatus)
                    if(istatus .ne. 1)then
                        return
                    endif
                endif
                lvl_3d(k) = nint(ht_1d(k))
                lvl_coord_3d(k) = '  ' ! informational
            else
                write(6,*)' Error, vertical grid not supported,'
     1                   ,' this routine supports PRESSURE or HEIGHT'
                istatus = 0
                return
            endif

            var_3d(k) = var_2d

        enddo ! k

        CALL WRITE_LAPS_DATA(I4TIME,DIRECTORY,EXT,ni,nj,
     1  nk,nk,VAR_3D,LVL_3D,LVL_COORD_3D,UNITS_3D,
     1                     COMMENT_3D,field_3d,ISTATUS)

        return
        end

        subroutine put_laps_multi_3d(i4time,EXT,var_2d,units_2d,
     1                          comment_2d,field_3d,ni,nj,nk,nf,istatus)

cdoc    Writes multiple 3-D grids. Inputs include the extension and time.

        logical ltest_vertical_grid

        character*150 DIRECTORY
        character*(*) EXT

        character*125 comment_3d(nk*nf),comment_2d(nf)
        character*10 units_3d(nk*nf),units_2d(nf)
        character*3 var_3d(nk*nf),var_2d(nf)
        integer LVL_3d(nk*nf)
        character*4 LVL_COORD_3d(nk*nf)
        real ht_1d(nk)

        real field_3d(ni,nj,nk,nf)

        istatus = 0

        call get_directory(ext,directory,len_dir)

        do l = 1,nf
            write(6,11)directory(1:min(len_dir,50)),ext,var_2d(l)
11          format(' Writing 3d ',a50,1x,a5,1x,a3)
        enddo ! l

        do l = 1,nf
          do k = 1,nk

            iscript_3d = (l-1) * nk + k

            units_3d(iscript_3d)   = units_2d(l)
            comment_3d(iscript_3d) = comment_2d(l)
            if(ltest_vertical_grid('HEIGHT'))then
                lvl_3d(iscript_3d) = zcoord_of_level(k)/10
                lvl_coord_3d(iscript_3d) = 'MSL'
            elseif(ltest_vertical_grid('PRESSURE'))then
                lvl_3d(iscript_3d) = nint(zcoord_of_level(k))/100
                lvl_coord_3d(iscript_3d) = 'HPA'
            elseif(ltest_vertical_grid('SIGMA_HT'))then
                if(k .eq. 1)then
                    write(6,*)' Reading Sigma Ht Levels'
                    call get_ht_1d(nk,ht_1d,istatus)
                    if(istatus .ne. 1)then
                        return
                    endif
                endif
! for other vertical_grid, lvl_3d(iscript_3d). Hongli Jiang 11/2/2011
                lvl_3d(iscript_3d) = nint(ht_1d(k))
                lvl_coord_3d(iscript_3d) = 'M' ! informational
            else
                write(6,*)' Error, vertical grid not supported,'
     1                   ,' this routine supports PRESSURE or HEIGHT'
                istatus = 0
                return
            endif

            var_3d(iscript_3d) = var_2d(l)

          enddo ! k
        enddo ! l

        CALL WRITE_LAPS_DATA(I4TIME,DIRECTORY,EXT,ni,nj,
     1  nk*nf,nk*nf,VAR_3D,LVL_3D,LVL_COORD_3D,UNITS_3D,
     1                     COMMENT_3D,field_3d,ISTATUS)

        if(istatus .ne. 1)return

        istatus = 1

        return
        end

        subroutine put_compressed_multi_3d(i4time,EXT,var_2d,units_2d,
     1                          comment_2d,field_3d,ni,nj,nk,nf,istatus)

cdoc    Writes multiple 3-D compressed grids. Inputs include the extension and
cdoc    time.

        logical ltest_vertical_grid

        character*150 DIRECTORY
        character*(*) EXT

        character*125 comment_3d(nk*nf),comment_2d(nf)
        character*10 units_3d(nk*nf),units_2d(nf)
        character*3 var_3d(nk*nf),var_2d(nf)
        integer LVL_3d(nk*nf)
        character*4 LVL_COORD_3d(nk*nf)
        real ht_1d(nk)

        real field_3d(ni,nj,nk,nf)

        istatus = 0

        call get_directory(ext,directory,len_dir)

        do l = 1,nf
            write(6,11)directory(1:min(len_dir,50)),ext,var_2d(l)
11          format(' Writing 3d ',a50,1x,a5,1x,a3)
        enddo ! l

        do l = 1,nf
          do k = 1,nk

            iscript_3d = (l-1) * nk + k

            units_3d(iscript_3d)   = units_2d(l)
            comment_3d(iscript_3d) = comment_2d(l)
            if(ltest_vertical_grid('HEIGHT'))then
                lvl_3d(iscript_3d) = zcoord_of_level(k)/10
                lvl_coord_3d(iscript_3d) = 'MSL'
            elseif(ltest_vertical_grid('PRESSURE'))then
                lvl_3d(iscript_3d) = nint(zcoord_of_level(k))/100
                lvl_coord_3d(iscript_3d) = 'HPA'
            elseif(ltest_vertical_grid('SIGMA_HT'))then
                if(k .eq. 1)then
                    write(6,*)' Reading Sigma Ht Levels'
                    call get_ht_1d(nk,ht_1d,istatus)
                    if(istatus .ne. 1)then
                        return
                    endif
                endif
                lvl_3d(k) = nint(ht_1d(k))
                lvl_coord_3d(k) = '  ' ! informational
            else
                write(6,*)' Error, vertical grid not supported,'
     1                   ,' this routine supports PRESSURE or HEIGHT'
                istatus = 0
                return
            endif

            var_3d(iscript_3d) = var_2d(l)

          enddo ! k
        enddo ! l

        CALL WRITE_LAPS_COMPRESSED(I4TIME,DIRECTORY,EXT,ni,nj,
     1  nk*nf,nk*nf,VAR_3D,LVL_3D,LVL_COORD_3D,UNITS_3D,
     1                     COMMENT_3D,field_3d,ISTATUS)

        if(istatus .ne. 1)return

        istatus = 1

        return
        end

        subroutine put_laps_multi_2d(i4time,EXT,var_a,units_a,
     1                          comment_a,field_2d,ni,nj,nf,istatus)

cdoc    Writes multiple 2-D grids. Inputs include the extension and time.

        integer MAX_FIELDS
        parameter (MAX_FIELDS = 10)

        character*150 DIRECTORY
        character*(*) EXT

        character*125 comment_a(nf) ! ,comment
        character*10 units_a(nf)
        character*3 var_a(nf)
        integer LVL_2d(MAX_FIELDS)
        character*4 LVL_COORD_2d(MAX_FIELDS)

        real field_2d(ni,nj,nf)

        istatus = 0

        if(nf .gt. MAX_FIELDS)then
            write(6,*)' Too many fields in put_laps_multi_2d'
        endif

        call get_directory(ext,directory,len_dir)
        call s_len(ext,len_ext)

        do l = 1,nf
            write(6,11)directory(1:len_dir),ext(1:len_ext),var_a(l)
11          format(' Writing 2d ',a,1x,a,1x,a)

            call check_nan2(field_2d(1,1,l),ni,nj,istatus)
            if(istatus .ne. 1)then
                write(6,*)' ERROR: Nan Detected in above 2D field'
                return
            endif
        enddo ! l

        do l = 1,nf
            lvl_2d (l)= 0
            lvl_coord_2d(l) = 'MSL'
!           comment_a(l) = comment
        enddo ! l

        CALL WRITE_LAPS_DATA(I4TIME,DIRECTORY,EXT,ni,nj,
     1  nf,nf,VAR_A,LVL_2D,LVL_COORD_2D,UNITS_A,
     1                     COMMENT_A,field_2d,ISTATUS)

        if(istatus .ne. 1)return

        istatus = 1

        return
        end

        subroutine sort_integer(i_array,i_dim,istatus)

        integer i_array(i_dim)

 10     i_switch = 0
        do i = 2,i_dim
            if(i_array(i) .lt. i_array(i-1))then ! Bubble sort exchange
                izzz = i_array(i-1)
                i_array(i-1) = i_array(i)
                i_array(i) = izzz
                i_switch = 1
            endif
        enddo

        if(i_switch .eq. 1)goto 10

        return
        end

        subroutine lapsprd_file_exist(i4time,ext,l_exist,istatus)

        character*(*)    ext
        character*150    directory
        character*13 filename13

        logical l_exist

!       Test for proper length of extension
        call s_len(ext,len_ext)
        if(len_ext .ne. 3)then
           write(6,*)' Error in open_lapsprd_file: ext has length'
     1               ,len_ext
           istatus = 0
           return
        endif

        call get_directory(ext,directory,len_dir)

        inquire(file=directory(1:len_dir)//filename13(i4time,ext(1:3))
     1         ,exist=l_exist)

 999    istatus = 1
        return
        end

        subroutine open_lapsprd_file(lun,i4time,ext,istatus)

!       1997   Steve Albers

        character*(*)    ext
        character*150    directory
        character*13 filename13
        character*14 filename14

!       Test for proper length of extension
        call s_len(ext,len_ext)
        if(len_ext .ne. 3 .and. len_ext .ne. 4)then
           write(6,*)' Error in open_lapsprd_file: ext has length'
     1               ,len_ext
           istatus = 0
           return
        endif

        call get_directory(ext,directory,len_dir)

        if(len_ext .eq. 3)then
         open(lun,file=directory(1:len_dir)//filename13(i4time,ext(1:3))
     1          ,status='unknown',err=998)
        else ! length of 4
         open(lun,file=directory(1:len_dir)//filename14(i4time,ext(1:4))
     1          ,status='unknown',err=998)
        endif
        go to 999

 998    write(6,*)' Error in open_lapsprd_file, cannot open product: '
     1            ,ext
        istatus = 0
        return

 999    istatus = 1
        return
        end

        subroutine open_lapsprd_file_read(lun,i4time,ext,istatus)

!       1997   Steve Albers

        character*(*)    ext
        character*150    directory
        character*13 filename13

!       Test for proper length of extension
        call s_len(ext,len_ext)
        if(len_ext .ne. 3 .and. len_ext .ne. 4)then
           write(6,*)' Error in open_lapsprd_file_read: ext has length'
     1               ,len_ext
           istatus = 0
           return
        endif

        call get_directory(ext,directory,len_dir)

        open(lun,file=directory(1:len_dir)//filename13(i4time,ext(1:3))
     1          ,status='old',err=998)
        go to 999

 998    write(6,*)' Warning in open_lapsprd_file_read: '
     1           ,'cannot open the product ',ext
        istatus = 0
        return

 999    istatus = 1
        return
        end

        subroutine open_lapsprd_file_append(lun,i4time,ext,istatus)

!       1997   Steve Albers

        character*(*)    ext
        character*150    directory
        character*13 filename13
        integer istatus
!       Test for proper length of extension
        call s_len(ext,len_ext)
        if(len_ext .ne. 3 .and. len_ext .ne. 4)then
           write(6,*)' Error in open_lapsprd_file: ext has length'
     1               ,len_ext
           istatus = 0
           return
        endif

        call get_directory(ext,directory,len_dir)

        call open_append(lun,directory(1:len_dir)//
     +       filename13(i4time,ext(1:3)),'unknown',istatus)

        if(istatus.eq.0) then
           write(6,*)
     1          ' Error in open_lapsprd_file_append: ',
     2          'cannot open the file ',
     3          directory(1:len_dir)//filename13(i4time,ext(1:3))
        else
           istatus = 1
        endif

        return
        end ! open_lapsprd_file_append

      subroutine open_ext(lun,i4time_sys,ext,istatus)

      integer iopen
      save iopen
      data iopen /0/

      character*3 ext

!     Open output lapsprd file
      if(iopen .eq. 0)then
          call open_lapsprd_file(lun,i4time_sys,ext,istatus)
          if(istatus .ne. 1)then
              write(6,*)' ERROR: could not open lapsprd file ',ext
              stop
          else
              write(6,*)' Successfully Opened lapsprd file for ',ext
          endif

          iopen = 1
      endif

      return
      end

        subroutine get_filespec(ext,mode,c_filespec,istatus)

!       1997   Steve Albers

        character*(*)    ext         ! input
        integer          mode        ! input
        character*(*)    c_filespec  ! output

        character*150    directory

        istatus = 1

        call s_len(ext,len_ext)
        call get_directory(ext,directory,len_dir)

        if(mode .eq. 1)then ! short form
            if(len(c_filespec) .lt. len_dir)then
                istatus = 0
                write(6,*)' Error in get_filespec, c_filespec too short'
            else
                c_filespec = directory(1:len_dir)
            endif
        else                ! long form
            if(len(c_filespec) .lt. len_dir+len_ext+2)then
                istatus = 0
                write(6,*)' Error in get_filespec, c_filespec too short'
            else
                c_filespec = directory(1:len_dir)//'*.'//ext(1:len_ext)
            endif
        endif

        return
        end
c
c J Smart 3/98.
c
        subroutine get_laps_sat(maxsat,c_sat_id,isats
     1     ,i4time_needed,i4tol,i4time_nearest
     1     ,var_2d,units_2d,comment_2d,imax,jmax
     1     ,subpoint_lat_clo,subpoint_lon_clo         ! O
     1     ,lat,lon,field_2d,istatus)
c
c    J. Smart 2-98.
cdoc This routine acquires satellite data from the lvd subdirectories
cdoc and makes decisions about what the best data is to return as the
cdoc 2d field (for var_2d).

        use mem_namelist, ONLY: l_mosaic_sat, r_missing_data
c
        implicit none

        integer imax,jmax,maxsat,min,max,iskip

        real    field_2d_lvd(imax,jmax,maxsat)
        real    field_2d(imax,jmax)
        real    lat(imax,jmax)
        real    lon(imax,jmax)
        real    subpoint_lat_clo(imax,jmax)
        real    subpoint_lon_clo(imax,jmax)
        real    subpoint_lon_sat(maxsat)
        real    cost(imax,jmax,maxsat)
        real    costmin(imax,jmax), fracp, time_diff_sec
        real    satm_time_wt,satm_subp_wt

        integer   isats(maxsat)
        integer   nsats
        integer   npts(maxsat)

        integer   i4time_needed
        integer   i4time_nearest
        integer   i4tol
        integer   i4timedata(maxsat)
        integer   i4time_min
        integer   i4time_sys
        integer   min_i4time

        integer   i,j,isat
        integer   imn
        integer   istatus
        integer   jstatus

        character comment_2d*125
        character units_2d*10
        character asc9_tim*9
        character var_2d*3
        character c_sat_id(maxsat)*6   !satellite id's known to system
        character csatid(maxsat)*6   !satellite id's returned from routine

        integer   i4time_first
c       data      i4time_first/0/
c       save      i4time_first

        call get_systime_i4(i4time_sys,istatus)
        istatus=1   !data was found
        nsats=0
        npts=0
        i4time_first=0
        subpoint_lon_sat = -75.            ! fill satellite array (default)
        subpoint_lat_clo = 0.
        satm_time_wt = 1./60.
        satm_subp_wt = 1.0

        do i=1,maxsat
           if(isats(i).eq.1)then
              call get_laps_lvd(c_sat_id(i),
     &                 i4time_needed,i4tol,i4time_nearest,
     &                 i4time_sys,
     &                 var_2d,units_2d,comment_2d,
     &                 imax,jmax,field_2d,jstatus)

              if(jstatus.ne.1)then
                 write(6,*)'No data returned from get_laps_lvd',
     &                     ' for ',c_sat_id(i)
              else
                 nsats=nsats+1
                 csatid(nsats)=c_sat_id(i)
                 i4timedata(nsats)=i4time_nearest
                 call move(field_2d,field_2d_lvd(1,1,nsats),imax,jmax)
                 write(6,*)' Comment is:',trim(comment_2d)
                 read(comment_2d,1)subpoint_lon_sat(nsats)
 1               format(83x,e17.8)
                 write(6,*)' Sublon for satellite: ',nsats
     1                      ,subpoint_lon_sat(nsats)

              endif
           endif
        enddo
c
c this section can make decisions about which satellite data
c to return in the event there is more than 1 2d field.
c
        write(6,*)' nsats / l_mosaic_sat = ',nsats,l_mosaic_sat

        if(nsats.gt.1 .and. l_mosaic_sat)then
           write(6,*)
           write(6,*)'Mosaicing ',nsats,' satellites'
           subpoint_lon_clo = r_missing_data  ! fill grid

           cost = 9999. ! initialize array

           do isat=1,nsats

              time_diff_sec = i4timedata(isat) - i4time_sys

              write(6,*)' isat/time_diff = ',isat,time_diff_sec

!             Determine cost of satellite based on valid data, time, and subpoint
              where(field_2d_lvd(:,:,isat) .ne. r_missing_data)
                 cost(:,:,isat)
     1           = abs(lon(:,:) - subpoint_lon_sat(isat)) * satm_subp_wt
     1           + abs(time_diff_sec) * satm_time_wt
              end where

           enddo ! isat

           do i = 1,imax
           do j = 1,jmax
               costmin(i,j) = minval(cost(i,j,:))
           enddo ! j
           enddo ! i

           write(6,*)' Summary of cost function'
           j = jmax/2
           iskip = max(((imax/100)/5)*5,5)
           do i = 1,imax,iskip
               write(6,*)i,lon(i,j),cost(i,j,1:nsats)
           enddo ! i

           do isat=1,nsats
              call make_fnam_lp(i4timedata(isat),asc9_tim,istatus)

!             Add satellite to mosaic if it has the lowest cost
              do i = 1,imax
              do j = 1,jmax
                  if(field_2d_lvd(i,j,isat) .ne. r_missing_data
     1                            .AND.
     1              cost(i,j,isat) .eq. costmin(i,j)
     1                                                           )then
                    npts(isat) = npts(isat) + 1
                    subpoint_lon_clo(i,j) = subpoint_lon_sat(isat)
                    field_2d(i,j) = field_2d_lvd(i,j,isat)
                  endif
              enddo ! j
              enddo ! i

              fracp = float(npts(isat)) / float(imax*jmax)

              write(6,11)var_2d,csatid(isat),asc9_tim
     &                 ,subpoint_lon_sat(isat),npts(isat),fracp
11            format('Mosaicing ',a,' for ',a,1x,a,f8.2
     1                           ,' npts/frac=',i8,f10.6)

           enddo ! isat
           return

        elseif(nsats .gt.1 .and. (.not. l_mosaic_sat))then
           write(6,*)
           write(6,*)'Found data for ',nsats,' satellites'

!          This option may never be exercised since 'i4time_first' is earlier
!          set to 0.
           do i=1,nsats
              if(i4timedata(i).eq.i4time_first)then
                 call make_fnam_lp(i4timedata(i),asc9_tim,istatus)
                 call move(field_2d_lvd(1,1,i),field_2d,imax,jmax)
                 i4time_nearest=i4timedata(i)
                 subpoint_lon_clo = subpoint_lon_sat(i)
                 write(6,*)'Returning ',var_2d,' for ',csatid(i),
     &                     ' ',asc9_tim,' 1'
                 return
              endif
           enddo

!          If two satellites are equally close the nominal time, the one
!          showing up earlier in the list of satellite IDs
!          (in satdata_lvd_table.for) will be chosen. At present the subpoint
!          is not considered.
           min_i4time=i4time_sys
           do i=1,nsats
              i4time_min=abs(i4timedata(i)-i4time_sys)
              if(i4time_min.lt.min_i4time)then
                 imn=i
                 min_i4time=i4time_min
              endif
           enddo

           if(imn.ne.0)then
              i4time_first=i4timedata(imn)
              call make_fnam_lp(i4timedata(imn),asc9_tim,istatus)
              call move(field_2d_lvd(1,1,imn),field_2d,imax,jmax)
              i4time_nearest=i4timedata(imn)
              subpoint_lon_clo = subpoint_lon_sat(imn)
              write(6,*)'Returning ',var_2d,' for ',csatid(imn),
     &                  ' ',asc9_tim,' 2'
              return

           else
c default
              i4time_first=i4timedata(1)
              call make_fnam_lp(i4time_first,asc9_tim,istatus)
              call move(field_2d_lvd(1,1,1),field_2d,imax,jmax)
              i4time_nearest=i4timedata(1)
              subpoint_lon_clo = subpoint_lon_sat(1)
              write(6,*)'Returning ',var_2d,' for ',csatid(1),
     &                  ' ',asc9_tim,' 3'
              return
           endif

        elseif(nsats.eq.1)then
           i4time_first=i4timedata(1)
           call make_fnam_lp(i4time_first,asc9_tim,istatus)
           call move(field_2d_lvd(1,1,1),field_2d,imax,jmax)
           i4time_nearest=i4timedata(1)
           subpoint_lon_clo = subpoint_lon_sat(1)
           write(6,*)
           write(6,*)'Returning ',var_2d,' for ',csatid(1),
     &                ' ',asc9_tim,' 4'
           return

        elseif(nsats.le.0)then
           write(6,*)'No lvd fields found. Returning  no data'

        endif

        istatus=0
        return
        end
c
c--------------------------------------------------------------------
c
        subroutine get_laps_lvd(c_sat_id,
     1      i4time_needed,i4tol,i4time_nearest
     1     ,i4time_sys
     1     ,var_2d,units_2d,comment_2d
     1     ,imax,jmax,field_2d,istatus)

!       Steve Albers            1996
!       This routine tries to read in the desired variable from all files
!       having the proper extension, picking the closest one within the
!       specified time window.
!
!       John Smart              1998
!       Modified original get_laps_2dvar for satellite lvd files in
!       lvd subdirectories. Subdirectories are those satellites
!       known to the laps system (see src/include/satdata_lvd.for,
!       and data/static/satellite_lvd.nl). As many as 'maxsat' 2d fields
!       can be returned depending on configuration specified in satellite_lvd.nl.
!       max_sat is defined in src/include/satellite_dims_lvd.inc.
!
!       John Smart              1999
!       Added multiple lvd file search for best domain cover for files that
!       are within i4tol. If all files have the same domain cover (like 100%)
!       then the first (and closest in time) file is returned.
!
!       John Smart              1999
!       return the time closest to requested time in the event that more
!       than 1 file with complete domain cover satisfies i4tol

        character*150 dir
        character*150 satdir
        character*31  EXT

        character*125 comment_2d
        character*10 units_2d
        character*3 var_2d
        integer LVL_2d
        character*4 LVL_COORD_2d

        integer max_lvd_files
        parameter (max_lvd_files=20)

        real field_2d(imax,jmax)
        real field_2d_save(imax,jmax,max_lvd_files)

        integer max_files
        parameter (max_files = 600)

        character*9 asc9_tim
        character*9 asc9_time(max_files)

        real pctmiss(max_files)
        real pctmnmiss
        real r_missing_data
        integer jf,jr,imiss

        character*255 c_filespec
        character*125 comment_2d_save(max_lvd_files)
        character*120 c_fnames(max_files)
        integer i4times(max_files)
        integer i4times_data(max_lvd_files)
        integer i_selected(max_files)
        character*6 c_sat_id          !input satellite id's known to system
        logical lcont

        call make_fnam_lp(i4time_needed,asc9_tim,istatus)

        write(6,*)
        write(6,*)' Subroutine get_laps_lvd for ',c_sat_id,
     1            ' needed at ',asc9_tim,'...'

        ext = 'lvd'
        call get_directory(ext,dir,ldir)

        do i = 1,31
            if(ext(i:i) .eq. ' ')goto20
        enddo
20      lext = i-1

        do j = 1,max_files
           i_selected(j) = 0
        enddo ! j

        satdir=dir(1:ldir)//trim(c_sat_id)//'/'
        lsdir=index(satdir,' ')-1
        c_filespec = satdir(1:lsdir)//'*.'//ext(1:lext)

        call get_r_missing_data(r_missing_data,istat)
        call get_file_times(c_filespec,max_files,c_fnames
     1                     ,i4times,i_nbr_files_ret,istatus)
        if(istatus .ne. 1)then
           write(6,*)'get_laps_lvd: Bad status returned '
     1              ,'from get_file_times'
           return
        endif

        lcont=.true.
        jf=0

        print*,'Number of files returned get_file_times',i_nbr_files_ret

!       Calculate minimum time difference of unselected files from desired time
!       with respect to both needed time and system time
50      i4_diff_min = 999999999
        i4_diff_min_sys = 999999999
        do j = 1,i_nbr_files_ret
           i4_diff = abs(i4times(j) - i4time_needed)
           i4_diff_sys=abs(i4times(j)-i4time_sys)
           if(i_selected(j) .eq. 0)then
            i4_diff_min     = min(i4_diff    ,i4_diff_min)
            i4_diff_min_sys = min(i4_diff_sys,i4_diff_min_sys)
           endif
        enddo ! j

!       Check whether any unselected files lie within the time window
        if(i4_diff_min_sys .gt. i4tol)then
           write(6,*)' No remaining files found within ',i4tol
     1              ,' sec systime window ',ext(1:5),var_2d
           write(6,*)' Closest file (in seconds) is ',i4_diff_min_sys

           lcont=.false.

c          istatus = 0
c          return
        endif

        do j=1,i_nbr_files_ret

           i4_diff=    abs(i4times(j)-i4time_needed)
           i4_diff_sys=abs(i4times(j)-i4time_sys)

!          Select file that has minimum time diff (of unselected)
           if(i4_diff.eq.i4_diff_min.and.
     1            i_selected(j).eq.0.and.
     1            i4_diff_sys.le.i4tol)               then

              i_selected(j) = 1
              lvl_2d = 0
              lvl_coord_2d = 'MSL'
              call make_fnam_lp(i4times(j),asc9_tim,istatus)

              write(6,11)trim(satdir),asc9_tim,ext(1:5),var_2d
11            format(' Reading 2d ',a,1x,a9,1x,a5,1x,a3)

              CALL READ_LAPS_DATA(i4times(j),satdir,EXT,imax
     1            ,jmax,1,1,VAR_2D,LVL_2D,LVL_COORD_2D,UNITS_2D
     1            ,COMMENT_2D,field_2d,ISTATUS)

              if(istatus .ne. 1)then
                 write(6,*)' No field found at ',ext(1:10)
     1                       ,var_2d,' ',asc9_tim
                 go to 50
c
c we need to expect some missing data in the lvd fields.
c determine which lvd file within the time window has the best
c domain coverage.
c
              else   !  istatus = 1, check for domain cover maxima

                 jf=jf+1
                 if(jf .gt. max_lvd_files)then
                     write(6,*)' ERROR in get_laps_lvd: jf > '
     1                        ,max_lvd_files
                     stop
                 endif

                 imiss=0
                 do il = 1,imax
                 do jl = 1,jmax

!                   QC check
                    if(field_2d(il,jl) .gt. 1e10)then
                       field_2d(il,jl) = r_missing_data
                    endif

                    if(field_2d(il,jl) .eq. r_missing_data)then
                       imiss=imiss+1

c                           write(6,*)il,jl,
c    1                        ' Missing Data Value Detected in 2D Field'
c                           istatus = -1
c                           return

                    endif
                    field_2d_save(il,jl,jf)=field_2d(il,jl)
                 enddo ! j
                 enddo ! i

                 pctmiss(jf)=float(imiss)/float(imax*jmax)
                 asc9_time(jf)=asc9_tim
                 i4times_data(jf)=i4times(j)
                 comment_2d_save(jf)=comment_2d
                 write(6,*)'         pctmiss = ',pctmiss(jf)

              endif

c             return

              if(lcont)goto 50

           endif ! File is closest unread file to desired time

        enddo ! ith file
c
c full domain coverage takes precedence over time matching.
c
        pctmnmiss=1.0
        jr=0
        if(jf.gt.1)then
           do i=1,jf
              if(pctmiss(i).le.pctmnmiss)then
                 jr=jr+1
                 pctmnmiss=pctmiss(i)
              endif
           enddo
           if(jr.gt.1)then
              i4diffmn=1000.
              do i=1,jr
                 i4diff=abs(i4times_data(i)-i4time_needed)
                 if(i4diff.lt.i4diffmn)then
                    jf=i
                    i4diffmn=i4diff
                 endif
              enddo
           else
              jf=jr
           endif
        elseif(jf.eq.0)then
           istatus = 0
           return
        endif

        call move(field_2d_save(1,1,jf),field_2d,imax,jmax)
        print*,'Returning requested field from ',
     1' get_laps_lvd  ',c_sat_id,'   ',asc9_time(jf),'   ',var_2d
        i4time_nearest=i4times_data(jf)
        comment_2d=comment_2d_save(jf)
        istatus = 1

        return
        end

        subroutine get_3dgrid_dname(directory_in
     1         ,i4time_needed,i4tol,i4time_nearest
     1         ,EXT,var_2d,units_2d
     1         ,comment_2d,imax,jmax,kmax,field_3d,istatus)

cdoc    Returns a 3-D analysis grid. Inputs include a directory, ext, and time window.

!       directory_in        Input      Slash at end is optional
!       i4time_needed       Input      Desired i4time
!       imax,jmax,kmax      Input      LAPS grid dimensions
!       ext                 Input      3 character file extension
!       var_2d              Input      Which Variable do you want?
!       units_2d            Output     Units of data
!       Comment_2d          Output     Comment block
!       field_3d            Output     3D grid

        character*9 asc9_tim

        character*(*) DIRECTORY_IN
        character*255 DIRECTORY
        character*(*) EXT

        character*125 comment_3d(kmax),comment_2d
        character*10 units_3d(kmax),units_2d
        character*3 var_3d(kmax),var_2d
        integer LVL_3d(kmax)
        character*4 LVL_COORD_3d(kmax)

        real field_3d(imax,jmax,kmax)

        character*255 c_filespec

        logical ltest_vertical_grid

        write(6,*)' Subroutine get_3dgrid_dname...'

        call get_r_missing_data(r_missing_data,istatus)
        if(istatus .ne. 1)then
            write(6,*)' get_3dgrid_dname: bad istatus, return'
            return
        endif

        call s_len(ext,len_ext)
        call s_len(directory_in,len_dir)

        if(directory_in(len_dir:len_dir) .ne. '/')then
            directory = directory_in(1:len_dir)//'/'
            len_dir = len_dir + 1
        else
            directory = directory_in
        endif

        c_filespec = directory(1:len_dir)//'*.'//ext(1:len_ext)
        call get_file_time(c_filespec,i4time_needed,i4time_nearest)

        if(abs(i4time_needed - i4time_nearest) .le. i4tol)then
            call get_3d_dir_time(directory_in,i4time_nearest,EXT
     1                          ,var_2d,units_2d,comment_2d
     1                          ,imax,jmax,kmax,field_3d,istatus)

        else
            write(6,*)' No field found within window ',ext(1:10)
            istatus = 0
        endif

        return
        end

        subroutine get_3d_dir_time(directory_in,i4time
     1                            ,EXT,var_2d,units_2d
     1                            ,comment_2d
     1                            ,imax,jmax,kmax,field_3d,istatus)

cdoc    Returns a 3-D grid. Inputs include a directory, ext, and time.

!       directory_in        Input      Slash at end is optional
!       i4time              Input      Desired i4time
!       imax,jmax,kmax      Input      LAPS grid dimensions
!       ext                 Input      file extension
!       var_2d              Input      Which Variable do you want?
!       units_2d            Output     Units of data
!       Comment_2d          Output     Comment block
!       field_3d            Output     3D grid

        character*9 asc9_tim

        character*(*) DIRECTORY_IN
        character*255 DIRECTORY
        character*(*) EXT, var_2d

        character*125 comment_3d(kmax),comment_2d
        character*10 units_3d(kmax),units_2d
        character*3 var_3d(kmax)
        integer LVL_3d(kmax)
        character*4 LVL_COORD_3d(kmax)

        real field_3d(imax,jmax,kmax)

        character*255 c_filespec

        logical ltest_vertical_grid, l_is_vxx, l_compress_radar

        call get_r_missing_data(r_missing_data,istatus)
        if(istatus .ne. 1)then
            write(6,*)' get_3d_dir_time: bad istatus, return'
            return
        endif

        call s_len(ext,len_ext)
        call s_len(directory_in,len_dir)

        if(directory_in(len_dir:len_dir) .ne. '/')then
            directory = directory_in(1:len_dir)//'/'
            len_dir = len_dir + 1
        else
            directory = directory_in
        endif

        call make_fnam_lp(i4time,asc9_tim,istatus)

        len_high = max(45,len_dir)
        len_low = len_high - 44

        write(6,11)directory(len_low:len_high),asc9_tim,ext,var_2d
11      format('  get_3d_dir_time: ',a,1x,a,1x,a,1x,a)

        do k = 1,kmax
            units_3d(k)   = units_2d
            if(ltest_vertical_grid('HEIGHT'))then
                lvl_3d(k) = zcoord_of_level(k)/10
                lvl_coord_3d(k) = 'MSL'
            elseif(ltest_vertical_grid('PRESSURE'))then
                lvl_3d(k) = nint(zcoord_of_level(k))/100
                lvl_coord_3d(k) = 'MB'
            elseif(ltest_vertical_grid('SIGMA_HT'))then
                lvl_3d(k) = nint(zcoord_of_level(k))
                lvl_coord_3d(k) = 'M'
            else
                write(6,*)' Error, vertical grid not supported,'
     1                   ,' this routine supports PRESSURE or HEIGHT'
                istatus = 0
                return
            endif

            var_3d(k) = var_2d

        enddo ! k

        call get_l_compress_radar(l_compress_radar,istatus)
        if(istatus .ne. 1)return

        if(.not. l_is_vxx(EXT))then
          CALL READ_LAPS_DATA(I4TIME,DIRECTORY,EXT,imax,jmax,
     1          kmax,kmax,VAR_3D,LVL_3D,LVL_COORD_3D,UNITS_3D,
     1          COMMENT_3D,field_3d,ISTATUS)

        elseif(.not. l_compress_radar)then
          CALL READ_LAPS_DATA(I4TIME,DIRECTORY,EXT,imax,jmax,
     1          kmax,kmax,VAR_3D,LVL_3D,LVL_COORD_3D,UNITS_3D,
     1          COMMENT_3D,field_3d,ISTATUS)

          if(ISTATUS .ne. 1)then
            write(6,*)' Attempting compressed radar data read instead'
            call read_laps_compressed(i4time,directory,ext,imax,jmax
     1                               ,kmax,var_3d,lvl_3d,lvl_coord_3d
     1                               ,units_3d,comment_3d,field_3d
     1                               ,istatus)
          endif

        else ! l_compress_radar is TRUE for vxx file
          call read_laps_compressed(i4time,directory,ext,imax,jmax
     1                               ,kmax,var_3d,lvl_3d,lvl_coord_3d
     1                               ,units_3d,comment_3d,field_3d
     1                               ,istatus)

          if(ISTATUS .ne. 1)then
            write(6,*)' Attempting netCDF radar data read instead'
            CALL READ_LAPS_DATA(I4TIME,DIRECTORY,EXT,imax,jmax,
     1          kmax,kmax,VAR_3D,LVL_3D,LVL_COORD_3D,UNITS_3D,
     1          COMMENT_3D,field_3d,ISTATUS)
          endif

        endif

        comment_2d=comment_3d(1)
        units_2d=units_3d(1)

        return
        end

        function l_is_vxx(ext)

        character*(*) ext
        logical l_is_vxx

        l_is_vxx = .false.

        if(ext(1:1) .ne. 'v')return
        if(ext(2:2) .eq. '0')l_is_vxx = .true.
        if(ext(2:2) .eq. '1')l_is_vxx = .true.
        if(ext(2:2) .eq. '2')l_is_vxx = .true.
        if(ext(2:2) .eq. '3')l_is_vxx = .true.
        if(ext(2:2) .eq. '4')l_is_vxx = .true.
        if(ext(2:2) .eq. '5')l_is_vxx = .true.
        if(ext(2:2) .eq. '6')l_is_vxx = .true.
        if(ext(2:2) .eq. '7')l_is_vxx = .true.
        if(ext(2:2) .eq. '8')l_is_vxx = .true.
        if(ext(2:2) .eq. '9')l_is_vxx = .true.

        return
        end
c
c ------------------------------------------------------------------------
c This routine is used in get_maps_lapsgrid.f (subroutine get_modelfg_3d and
c other related routines). Returns bgmodel name corresponding to the
c setting of variable "cmodel" in lga namelist (background.nl).
c
      subroutine bgmodel_name(maxbgmodels,nbgm,bgmodelnames,istatus)

      implicit none

c     include 'bgdata.inc'

      integer       maxbgmodels
      character*256 bgpaths(maxbgmodels)
      character*132 cmodel(maxbgmodels)
      character*5   bgmodelnames(maxbgmodels)

      integer bgmodels(maxbgmodels)
      integer oldest_forecast
      integer max_forecast_delta
      integer forecast_length
      integer itime_inc,ntmin,ntmax
      integer nbgm
      logical sfc_bkgd
      logical use_analysis
      logical use_forecast
      logical smooth_fields
      logical lgb_only

      integer   istatus,i

      call get_background_info(bgpaths,bgmodels
     +,forecast_length
     +,use_analysis,use_forecast
     +,cmodel,itime_inc,smooth_fields
     +,sfc_bkgd
     +,ntmin,ntmax
     +,lgb_only)

      nbgm=0
      do i=1,maxbgmodels
         if(cmodel(i).ne.' ')then
            if(cmodel(i).eq.'RUC40_NATIVE'.or.
     +         cmodel(i).eq.'RUC20_NATIVE'.or.
     +         cmodel(i).eq.'RUC'              )then
               nbgm=nbgm+1
               bgmodelnames(nbgm)='ruc'
            endif
            if(cmodel(i).eq.'ETA48_CONUS'.or.
     +         cmodel(i).eq.'MesoEta_SBN')then
               nbgm=nbgm+1
               bgmodelnames(nbgm)='eta'
            endif
            if(cmodel(i).eq.'AVN_FSL_NETCDF'.or.
     +         cmodel(i).eq.'AVN_SBN_CYLEQ')then
               nbgm=nbgm+1
               bgmodelnames(nbgm)='avn'
            endif
            if(cmodel(i).eq.'MODEL_FUA'.or.
     +         cmodel(i).eq.'LAPS_FUA')then
               nbgm=nbgm+1
               bgmodelnames(nbgm)='fua'
            endif
            if(cmodel(i).eq.'CWB_20FA_LAMBERT_NF')then
               nbgm=nbgm+1
               bgmodelnames(nbgm)='nfs'
            endif
         endif
      enddo

      return
      end

cdis

        subroutine get_laps_multi_2d(i4time,EXT,var_2d,units_2d,
     1                  comment_2d,imax,jmax,nf,field_2d,istatus)

cdoc    Used to read in one or more surface grids with inputs of time and ext

        character*9 asc9_tim
        character*150 DIRECTORY
        character*(*) EXT

        character*125 comment_2d(nf)
        character*10 units_2d(nf)
        character*3 var_2d(nf)
        integer LVL_2d(nf)
        character*4 LVL_COORD_2d(nf)

        real field_2d(imax,jmax,nf)

        call get_r_missing_data(r_missing_data,istatus)
        if(istatus .ne. 1)then
            write(6,*)' get_laps_multi_2d: bad istatus, return'
            return
        endif

        call get_directory(ext,directory,len_dir)

        call make_fnam_lp(i4time,asc9_tim,istatus)

        write(6,11)trim(directory),asc9_tim,ext,var_2d
11      format(' Reading 2d ',a,1x,a,1x,a,1x,a)

        lvl_2d = 0
        lvl_coord_2d = 'MSL'

        CALL READ_LAPS_DATA(I4TIME,DIRECTORY,EXT,imax,jmax,
     1  nf,nf,VAR_2D,LVL_2D,LVL_COORD_2D,UNITS_2D,
     1                     COMMENT_2D,field_2d,ISTATUS)

!       Check for missing data
        do if = 1,nf
        do j = 1,jmax
        do i = 1,imax
            if(istatus .eq. 1)then
                if(field_2d(i,j,if) .eq. r_missing_data)then
                    write(6,*)' Missing Data Value Detected in 2D Field'
                    istatus = -1
                endif
            endif
        enddo ! i
        enddo ! j
        enddo ! if

        return
        end

max_stars_repo_name: maxinye/laps-mirror

max_stars_repo_licenses: Intel Unlicense OLDAP-2.2.1 NetCDF

max_issues_repo_name: longwosion/laps-mirror

max_issues_repo_licenses: Intel NetCDF OLDAP-2.2.1 Unlicense

max_forks_repo_name: longwosion/laps-mirror

max_forks_repo_licenses: Intel NetCDF OLDAP-2.2.1 Unlicense


text:
c=======================================================================
c
c     GENEXP
c
c     Exponential distribution generator
c
c     Generates a single random deviate from an exponential
c     distribution with mean AV.
c
c-----------------------------------------------------------------------
c
c-----------------------------------------------------------------------
      DOUBLE PRECISION FUNCTION genexp(av)
c-----------------------------------------------------------------------
c
c     INPUT :
c      AV : the mean of the exponential distribution from which
c           a random deviate is to be generated (AV >= 0)         double
c
c     Method
c
c     Renames SEXPO from TOMS as slightly modified by BWB to use RANF
c     instead of SUNIF.
c
c     For details see:
c               Ahrens, J.H. and Dieter, U.
c               Computer Methods for Sampling From the
c               Exponential and Normal Distributions.
c               Comm. ACM, 15,10 (Oct. 1972), 873 - 882.
c
c----------------------------------------------------------------------
c
c     scalar arguments
      DOUBLE PRECISION av
c
c     external functions
      DOUBLE PRECISION sexpo
      EXTERNAL sexpo
c
c     executable statements
 10   genexp = sexpo()*av
      RETURN
      END

max_stars_repo_name: alpgodev/numx

max_issues_repo_name: alpgodev/numx

max_forks_repo_name: alpgodev/numx