Passer au contenu | Passer aux liens institutionnels

Common menu bar links

Institutional links

Menu principal

Sciences

Divulgation proactive

Divulgation proactive

Logiciel des profils océanographiques

Introduction
Exemple 1
Exemple 2
Exemple 3
Exemple 4
Exemple 5
Exemple 6
Lecture du format ASCII du SDMM
Écriture de données dans les tables

Introduction

Les deux programmes présentés ici montrent la façon de lire le format ASCII du SDMM pour la base de données à mise à jour continue. Le premier, appelé MEDS_ASCII_LIST, permet de produire une liste du contenu d’un fichier vers une imprimante. Le deuxième, appelé OCPROC_TO_TABLES, permet de lire une forme binaire du format et d’envoyer le contenu en sortie des structures FORTRAN vers des fichiers distincts dans un format de valeur séparé par des virgules. Cette dernière forme peut être utilisée pour verser les données dans tout logiciel d’application comme des programmes de feuilles de calcul ou certaines bases de données relationnelles. Vous pouvez utiliser ce deuxième programme de pair avec le premier pour passer du format de données à des tableaux.

Voici quelques exemples de la façon d’utiliser le contenu du format afin de filtrer les enregistrements d’intérêt. Les modifications logicielles présentées dans ces exemples occupent des emplacements appropriés dans le premier programme.

Exemple 1 :

Sélection des stations qui présentent un marqueur de qualité 'good' pour la position.

Le marqueur de qualité pour la position se trouve dans la structure FXD et se nomme Q_POS. Il s’agit d’un champ à un caractère; les bonnes positions portent le marqueur de caractère '1'. Au point marqué C*** Exemple 1 dans MEDS_ASCII_LIST, insérer simplement

IF (STAT.FXD.Q_POS.NE.'1') ILIKE = 0

La variable ILIKE est utilisée comme commutateur pour contrôler si oui ou non les données de la station lue s’impriment ou non. Si ILIKE présente une valeur différente de 1, elle n’est pas imprimée. Au lieu d’imprimer la station, vous pouvez écrire l’information dans un fichier.

Exemple 2 :

Sélection des stations de profils de température et de salinité seulement.

Ce processus exige la consultation du contenu de la structure PROF de l’enregistrement de la station. Vous devez ajouter un code au point marqué C*** Exemple 2 dans MEDS_ASCII_LIST. D’abord, s’il n’y a qu’un type de profil, vous pouvez passer à la station suivante. Ainsi, juste avant

DO I=1,STAT.FXD.NO_PROF

inscrivez la vérification suivante

IF (STAT.FXD.NO_PROF.LT.2) ILIKE = 0

Encore une fois, nous avons utilisé la variable ILIKE pour annuler l’écriture de la station en sortie.

Mais cela n’est qu’une composante du travail. Maintenant, dans la boucle DO susmentionnée, vous devez vérifier si les profils de température et de salinité sont présents. STAT.PROF(I).PROF_TYPE est une variable de quatre caractères décrivant le profil. Vous devez vérifier 'TEMP' pour la température et tout 'PSAL', 'SSAL' ou 'USAL' pour la salinité. En présence des deux TEMP et de l’une des autres variables, définissez ILIKE à 1.

Exemple 3 :

Sélection des données qui ont été soumises au contrôle de la qualité scientifique seulement.

Pour trouver les données qui ont été soumises au contrôle de la qualité scientifique, vous pouvez consulter plusieurs endroits du format. Un endroit est le point marqué C*** Exemple 3-1. Chaque centre scientifique consigne les essais auxquels ont été soumises les données et quels essais ont échoué. Chaque essai à chaque centre scientifique est désigné par une valeur différente de STAT.SURF_CODES(I).PCODE. PCODE est une variable de quatre caractères. Recherchez PCODE 'QAO$' ou 'QAP$' pour trouver les essais effectués à l’AOML. Pour les essais menés au Scripps, recherchez 'QSP$' ou 'QSF$'. Pour ceux du CSIRO, recherchez 'QRF$' ou 'QRP$'. Si PCODE correspond à l’une de ces valeurs, les données ont été soumises au contrôle de la qualité scientifique au centre indiqué.

Une autre solution de vérifier où les données ont été étudiées consiste à utiliser la structure HISTORY. Consultez à ce sujet C*** Exemple 3-2. Cette partie du format est utilisée pour suivre le déplacement des données. À mesure que chaque organisme traite les données, il consigne au moins un enregistrement dans la structure de l’historique. STAT.HISTORY(I).IDENT_CODE est une variable de deux caractères. Les centres scientifiques consignent un enregistrement à l’aide de leur identificateurs de deux caractères. Pour l’AOML, l’identificateur est 'AO'. Pour le Scripps, il s’agit de 'SI' et pour le CSIRO, de 'CS'. Ainsi, il vous suffit de rechercher un IDENT_CODE correspondant à l’un de ces identificateurs pour savoir si les données ont été soumises au traitement du centre scientifique. Utilisez simplement

IF STAT.HISTORY(I).IDENT_CODE.EQ.'AO') ILIKE = 1

pour sélectionner seulement les enregistrements qui ont été soumis au traitement à l’AOML.

Exemple 4 :

Sélection de températures entre 100 et 400 m de profondeur seulement.

Pour ne trouver que les températures situées entre 100 et 400 m, vous devez rechercher dans les enregistrements des profils. Au point marqué C*** Exemple 4.1, vérifiez si PRF.FXD.PROF_TYPE est 'TEMP' et qu’il y a une indication du profil de température. Le cas échéant, dans la liste sous C*** Exemple 4.2, vous devez inscrire de l’information semblable à celle-ci.

IF (PRF.PROF(I).DEPTH_PRESS.GE.100. AND.
    PRF.PROF(I).DEPTH_PRESS.LE.400.) ILIKE = 1

Encore une fois, la variable ILIKE est utilisée pour indiquer s’il faut ou non sélectionner les résultats pour la sortie. Évidemment, vous pourriez faire d’autres choses à ce stade pour écrire uniquement les températures à ces profondeurs.

Vous pouvez également utiliser PRF.PROF(I).Q_PARM pour sélectionner seulement les valeurs qui portent un marqueur de qualité de données particulier (ce marqueur étant enregistré dans Q_PARM). Le logiciel nécessaire est semblable à ce qui a été indiqué ci-dessus dans l’exemple 1.

Vous devriez savoir que le format renferme au plus 1500 paires profondeur-valeur dans un seul enregistrement physique. Si un profil comporte plus de 1500 paires profondeur-valeur, il est divisé en segments. Le numéro de segment est donné par PRF.FXD.PROFILE_SEG et constituera une chaîne de caractères de '01', '02', etc. Vous devez vous assurer de lire tous les segments d’un profil. C’est ce que fait le logiciel au point du programme suivant le commentaire «Count the number of profile segments to read».

Exemple 5 :

Recherche de XBT qui ont utilisé les nouvelles équations de vitesse de chute.

À moins que l’information ne soit présente précisément, vous devez supposer que les anciennes équations ont été utilisées. Les variables XBT qui ont utilisé les nouvelles équations de vitesse de chute comportent toujours de l’information sur la sonde, l’enregistreur et les équations. Cette information est enregistrée dans la structure SURF_CODES. Vous devez rechercher un PCODE défini à 'PFR$'. Les valeurs enregistrées dans CPARM sont les valeurs des tables de codes WMO 1770 et 4770 dans cet ordre (consultez le document sur les codes WMO). Vous recherchez ces codes de la même façon que celle illustrée dans l’exemple 3-1 ci-dessus. Si le code est présent, recherchez les 3 premiers caractères de la valeur dans CPARM car ceux-ci codent le type de sonde et l’équation de vitesse de chute utilisés. Comparez ces données à la table de codes WMO 1770 pour déterminer quelle équation a été utilisée pour calculer la profondeur.

Exemple 6 :

Recherche des données XBT haute densité.

Pour trouver ces données, vous devrez utiliser le secteur océanographique, l’année et l’identificateur de navire. Le secteur océanographique donné dans la liste des lignes haute densité vous indiquera dans quels fichiers de secteur océanographique doit porter votre recherche. L’année restreindra la recherche à 4 fichiers (un pour chaque trimestre). Vous utiliserez ensuite l’identificateur de navire pour sélectionner uniquement les stations depuis chaque fichier. Pour y arriver, il faut insérer le code à l’emplacement marqué Exemple 6. Insérez

IF (STAT.FXD.CR_NUMBER.EQ.'SHIP 95') ILIKE = 1

où, encore une fois, la définition de la variable ILIKE à 1 signifie que vous voulez sélectionner cette station. À noter que vous devriez insérer l’identificateur de navire approprié et les deux derniers chiffres de l’année dont il est question. L’exemple traite des données d’un navire avec l’identificateur SHIP recueillies au cours de l’année 1995.

Lecture du format ASCII du SDMM

  
	PROGRAM MEDS_ASCII_LIST
C	Reads and lists the MEDS ASCII format written by NODC
	CHARACTER*25568 INSTR
C  	-------------------------------------------------------------
C...    STATION STRUCTURE
C  	-------------------------------------------------------------
	STRUCTURE /PR_STN/
	STRUCTURE FXD
		CHARACTER*8 	MKEY
		INTEGER*4 	ONE_DEG_SQ
		CHARACTER*10 	CR_NUMBER
		CHARACTER*4 	OBS_YEAR
		CHARACTER*2 	OBS_MONTH
		CHARACTER*2 	OBS_DAY
		CHARACTER*4 	OBS_TIME
		CHARACTER*2 	DATA_TYPE
		INTEGER*4 	IUMSGNO
		CHARACTER*1 	STREAM_SOURCE
		CHARACTER*1 	U_FLAG
		INTEGER*2 	STN_NUMBER
		REAL*4 		LATITUDE
		REAL*4 		LONGITUDE
		CHARACTER*1 	Q_POS
		CHARACTER*1 	Q_DATE_TIME
		CHARACTER*1 	Q_RECORD
		CHARACTER*8 	UP_DATE
		CHARACTER*12 	BUL_TIME
		CHARACTER*6 	BUL_HEADER
		CHARACTER*4 	SOURCE_ID
		CHARACTER*4 	STREAM_IDENT
		CHARACTER*4 	QC_VERSION
		CHARACTER*1 	AVAIL
		INTEGER*2 	NO_PROF
		INTEGER*2 	NPARMS
		INTEGER*2 	SPARMS
		INTEGER*2 	NUM_HISTS
	END STRUCTURE
	STRUCTURE PROF(1:20)
		INTEGER*2 	NO_SEG
		CHARACTER*4 	PROF_TYPE
		CHARACTER*1 	DUP_FLAG
		CHARACTER*1 	DIGIT_CODE
		CHARACTER*1 	STANDARD
		REAL*4 		DEEP_DEPTH
	END STRUCTURE
	STRUCTURE SURFACE(1:20)
		CHARACTER*4 	PCODE
		REAL*4 		PARM
		CHARACTER*1 	Q_PARM
	END STRUCTURE
	STRUCTURE SURF_CODES(1:20)
		CHARACTER*4 	PCODE
		CHARACTER*10 	CPARM
		CHARACTER*1 	Q_PARM
	END STRUCTURE
	STRUCTURE HISTORY(1:100)
		CHARACTER*2 	IDENT_CODE
		CHARACTER*4 	PRC_CODE
		CHARACTER*4 	VERSION
		INTEGER*4 	PRC_DATE
		CHARACTER*2 	ACT_CODE
		CHARACTER*4 	ACT_PARM
		REAL*4 		AUX_ID
		REAL*4 		O_VALUE
	END STRUCTURE
	END STRUCTURE
	RECORD /PR_STN/STAT
C  	-------------------------------------------------------------
C...	 PROFILE STRUCTURE
C  	-------------------------------------------------------------
	STRUCTURE /PR_PROFILE/
	STRUCTURE FXD
		CHARACTER*8 	MKEY
		INTEGER*4 	ONE_DEG_SQ
		CHARACTER*10 	CR_NUMBER
		CHARACTER*4 	OBS_YEAR
		CHARACTER*2 	OBS_MONTH
		CHARACTER*2 	OBS_DAY
		CHARACTER*4 	OBS_TIME
		CHARACTER*2 	DATA_TYPE
		INTEGER*4 	IUMSGNO
		CHARACTER*4 	PROF_TYPE
		CHARACTER*2 	PROFILE_SEG
		INTEGER*2 	NO_DEPTHS
		CHARACTER*1 	D_P_CODE
	END STRUCTURE
	STRUCTURE PROF(1:1500)
		REAL*4 		DEPTH_PRESS
		CHARACTER*1 	DP_FLAG
		REAL*4 		PARM
		CHARACTER*1 	Q_PARM
	END STRUCTURE
	END STRUCTURE
	RECORD /PR_PROFILE/PRF
C	
        OPEN(UNIT=1,STATUS='OLD',FORM='FORMATTED',
     &   RECORDTYPE='VARIABLE',READONLY,RECL=25568)
C 
	OPEN(UNIT=2,STATUS='NEW',FORM='FORMATTED')
C
C   Use ILIKE to qualify whether or not a record should be printed.
C   If ILIKE = 1 it prints, otherwise it does not.
	ILIKE = 1
	NWR=1
	NN=1
C
1	CONTINUE
	READ(1,100,END=999) INSTR
100	FORMAT(A25568)
C
C   Read FXD structure
	STAT.FXD.MKEY = INSTR(1:8)
	READ(INSTR(9:16),101) STAT.FXD.ONE_DEG_SQ
101	FORMAT(I8)
	STAT.FXD.CR_NUMBER = INSTR(17:26)
C*** Example 6
	STAT.FXD.OBS_YEAR = INSTR(27:30)
	STAT.FXD.OBS_MONTH = INSTR(31:32)
	STAT.FXD.OBS_DAY = INSTR(33:34)
	STAT.FXD.OBS_TIME = INSTR(35:38)
	STAT.FXD.DATA_TYPE = INSTR(39:40)
	READ(INSTR(41:52),102) STAT.FXD.IUMSGNO
102	FORMAT(I12)
	STAT.FXD.STREAM_SOURCE = INSTR(53:53)
	STAT.FXD.U_FLAG = INSTR(54:54)
	READ(INSTR(55:62),103) STAT.FXD.STN_NUMBER
103	FORMAT(I8)
	READ(INSTR(63:70),104)	STAT.FXD.LATITUDE
104	FORMAT(F8.4)
	READ(INSTR(71:79),105) STAT.FXD.LONGITUDE
105	FORMAT(F9.4)
	STAT.FXD.Q_POS = INSTR(80:80)
C*** Example 1
	STAT.FXD.Q_DATE_TIME = INSTR(81:81)
	STAT.FXD.Q_RECORD = INSTR(82:82)
	STAT.FXD.UP_DATE = INSTR(83:90)
	STAT.FXD.BUL_TIME = INSTR(91:102)
	STAT.FXD.BUL_HEADER = INSTR(103:108)
	STAT.FXD.SOURCE_ID = INSTR(109:112)
	STAT.FXD.STREAM_IDENT = INSTR(113:116)
	STAT.FXD.QC_VERSION = INSTR(117:120)
	STAT.FXD.AVAIL = INSTR(121:121)
	READ(INSTR(122:123),106) STAT.FXD.NO_PROF
106	FORMAT(I2)
	READ(INSTR(124:125),106) STAT.FXD.NPARMS
	READ(INSTR(126:127),106) STAT.FXD.SPARMS
	READ(INSTR(128:130),107) STAT.FXD.NUM_HISTS
107	FORMAT(I3)
C
C  	Read PROF structure
	ISTART = 131
C*** Example 2
	DO I=1,STAT.FXD.NO_PROF
	  IST = ISTART + 14*(I-1)
	  READ(INSTR(IST:IST+1),106) STAT.PROF(I).NO_SEG
	  STAT.PROF(I).PROF_TYPE = INSTR(IST+2:IST+5)
	  STAT.PROF(I).DUP_FLAG = INSTR(IST+6:IST+6)
	  STAT.PROF(I).DIGIT_CODE = INSTR(IST+7:IST+7)
	  STAT.PROF(I).STANDARD = INSTR(IST+8:IST+8)
	  READ(INSTR(IST+9:IST+13),108) STAT.PROF(I).DEEP_DEPTH
108	  FORMAT(F5.0)
	ENDDO
C
C   Read SURFACE structure
	ISTART = ISTART + 14*(STAT.FXD.NO_PROF)
	DO I=1,STAT.FXD.NPARMS
	  IST = ISTART + 15*(I-1)
	  STAT.SURFACE(I).PCODE = INSTR(IST:IST+3)
	  READ(INSTR(IST+4:IST+13),109) STAT.SURFACE(I).PARM
109	  FORMAT(F10.3)
	  STAT.SURFACE(I).Q_PARM = INSTR(IST+14:IST+14)
	ENDDO
C
C   Read SURF_CODES structure
	ISTART = ISTART + 15*(STAT.FXD.NPARMS)
C*** Example 3-1  
	DO I=1,STAT.FXD.SPARMS
	  IST = ISTART + 15*(I-1)
	  STAT.SURF_CODES(I).PCODE = INSTR(IST:IST+3)
	  STAT.SURF_CODES(I).CPARM = INSTR(IST+4:IST+13) 
	  STAT.SURF_CODES(I).Q_PARM = INSTR(IST+14:IST+14)
	ENDDO
C
C   Read HISTORY structure
	ISTART = ISTART + 15*(STAT.FXD.SPARMS)
	DO I=1,STAT.FXD.NUM_HISTS
	  IST = ISTART + 42*(I-1)
	  STAT.HISTORY(I).IDENT_CODE = INSTR(IST:IST+1)
C*** Example 3-2
	  STAT.HISTORY(I).PRC_CODE = INSTR(IST+2:IST+5)
	  STAT.HISTORY(I).VERSION = INSTR(IST+6:IST+9)
	  READ(INSTR(IST+10:IST+17),103) STAT.HISTORY(I).PRC_DATE
	  STAT.HISTORY(I).ACT_CODE = INSTR(IST+18:IST+19)
	  STAT.HISTORY(I).ACT_PARM = INSTR(IST+20:IST+23)
	  READ(INSTR(IST+24:IST+31),110) STAT.HISTORY(I).AUX_ID
110	  FORMAT(F8.3)
	  READ(INSTR(IST+32:IST+41),111) STAT.HISTORY(I).O_VALUE
111	  FORMAT(F10.5)
	ENDDO
C
	IF(ILIKE.EQ.1) THEN
	WRITE (6,4002) NWR
4002	FORMAT (///'***********************',I10/)
	WRITE (6,4001) STAT.FXD.MKEY,STAT.FXD.IUMSGNO,
     &   STAT.FXD.STREAM_SOURCE,STAT.FXD.U_FLAG
4001	FORMAT (' MKEY ',a10,'   IUMSGNO ',i10,'   STREAM_SOURCE ',a5,
     &   '   UFLAG ',a5)
C
	WRITE (6,4003) STAT.FXD.ONE_DEG_SQ,STAT.FXD.CR_NUMBER,
     &   STAT.FXD.OBS_YEAR,STAT.FXD.OBS_MONTH,STAT.FXD.OBS_DAY,
     &   STAT.FXD.OBS_TIME
4003	FORMAT (' ONE_DEG_SQ',1X,I6,3X,'CR_NUMBER',1X,A14,2X,'OBS_DATE',
     &   1X,A4,2A2,3X,'OBS_TIME',1X,A4)
C
	WRITE (6,4004) STAT.FXD.DATA_TYPE,STAT.FXD.STN_NUMBER,
     &   STAT.FXD.LATITUDE,STAT.FXD.LONGITUDE
4004	FORMAT (' DATA_TYPE',1X,A2,3X,' STN_NUMBER ',I5,3X,' LATITUDE',
     &   F10.4,3X,'LONGITUDE',F10.4)
C
	WRITE (6,4005) STAT.FXD.Q_POS,STAT.FXD.Q_DATE_TIME,
     &   STAT.FXD.Q_RECORD,STAT.FXD.UP_DATE
4005	FORMAT (' Q_POS ',A1,3X,'Q_DATE_TIME ',A1,3X,'Q_RECORD ',A1,3X,
     &   'UP_DATE ',A8)
C
	WRITE (6,4011) STAT.FXD.BUL_TIME,STAT.FXD.BUL_HEADER,
     &   STAT.FXD.SOURCE_ID,STAT.FXD.STREAM_IDENT,STAT.FXD.QC_VERSION,
     &   STAT.FXD.AVAIL
4011	FORMAT (' BUL_TIME',1X,A12,2X,'BUL_HEADER',1X,A6,2X,
     &   'SOURCE_ID',1X,A4,2X,'STREAM_IDENT',1X,A4/' QC_VERSION ',A4,3X,
     &   'DATA_AVAIL ',A1)
C
	WRITE (6,4006) STAT.FXD.NO_PROF,
     &   (STAT.PROF(I).NO_SEG,STAT.PROF(I).PROF_TYPE,
     &   STAT.PROF(I).DUP_FLAG,STAT.PROF(I).DIGIT_CODE,
     &   STAT.PROF(I).STANDARD,STAT.PROF(I).DEEP_DEPTH,
     &   I=1,STAT.FXD.NO_PROF)
4006	FORMAT (/' VECTOR OF ',I2,' PROFILE DESCRIPTORS - NO_SEG,'
     &   ' PROF_TYPE, DUP_FLAG,'/'   DIGIT_CODE, STANDARD, DEEP_DEPTH'/
     &   (I5,1X,A4,1X,A1,1X,A1,1X,A1,F8.1,'.'))
C
	WRITE (6,4007)  STAT.FXD.NPARMS,
     &   (STAT.SURFACE(I).PCODE,STAT.SURFACE(I).PARM,
     &   STAT.SURFACE(I).Q_PARM,
     &   I=1,STAT.FXD.NPARMS)
4007	FORMAT (/' VECTOR OF ',I2,' STATION LEVEL PARAMETERS - PCODE,'
     &   ' PARM, Q_PARM'/3(3X,A4,1X,F10.4,3X,A1))
C
	WRITE (6,4014) STAT.FXD.SPARMS,
     &   (STAT.SURF_CODES(I).PCODE,STAT.SURF_CODES(I).CPARM,
     &   STAT.SURF_CODES(I).Q_PARM,
     &   I=1,STAT.FXD.SPARMS)
4014	FORMAT (/' VECTOR OF ',I2,' STATION CHARACTER FIELDS - ',
     &   'SRFC_CODE, SRFC_PARM, SRFC_Q_PARM'/3(3X,A4,1X,A10,1X,A1))
C
	WRITE (6,4010) STAT.FXD.NUM_HISTS,
     &   (STAT.HISTORY(I).IDENT_CODE,STAT.HISTORY(I).PRC_CODE,
     &   STAT.HISTORY(I).VERSION,STAT.HISTORY(I).PRC_DATE,
     &   STAT.HISTORY(I).ACT_CODE,STAT.HISTORY(I).ACT_PARM,
     &   STAT.HISTORY(I).AUX_ID,STAT.HISTORY(I).O_VALUE,
     &   I=1,STAT.FXD.NUM_HISTS)
4010	FORMAT (//' VECTOR OF ',I3,' HISTORY RECORDS'/
     &   ' - IDENT_CODE, PRC_CODE, VERSION, PRC_DATE, ACT_CODE, 
     &   ACT_PARM, AUX_ID, ORIG_VAL'/
     &   (1X,A2,1X,A4,2X,A4,2X,I8,2X,A2,2X,A4,2X,F9.3,2X,F9.3))
	NWR=NWR+1
	ENDIF
C
C  Count the number of profile segments to read
	NO_PRF = 0
	DO I = 1,STAT.FXD.NO_PROF
	  NO_PRF = NO_PRF + STAT.PROF(I).NO_SEG
	ENDDO
C
C  Read the profile segments
	DO J=1,NO_PRF
	  READ(1,100,END=999) INSTR
C  Read FXD structure
	  PRF.FXD.MKEY = INSTR(1:8)
	  READ(INSTR(9:16),101) PRF.FXD.ONE_DEG_SQ
	  PRF.FXD.CR_NUMBER = INSTR(17:26)
	  PRF.FXD.OBS_YEAR = INSTR(27:30)
	  PRF.FXD.OBS_MONTH = INSTR(31:32)
	  PRF.FXD.OBS_DAY = INSTR(33:34)
	  PRF.FXD.OBS_TIME = INSTR(35:38)
	  PRF.FXD.DATA_TYPE = INSTR(39:40)
	  READ(INSTR(41:52),102) PRF.FXD.IUMSGNO
	  PRF.FXD.PROF_TYPE = INSTR(53:56)
C*** Example 4.1
	  PRF.FXD.PROFILE_SEG = INSTR(57:58)
	  READ(INSTR(59:62),112) PRF.FXD.NO_DEPTHS
112	  FORMAT(I4)
	  PRF.FXD.D_P_CODE = INSTR(63:63)
C
C   Read PROF structure
	  ISTART = 64
	  DO I=1,PRF.FXD.NO_DEPTHS
	    IST = ISTART + 17*(I-1)
C*** Example 4.2
	    READ(INSTR(IST:IST+5),113) PRF.PROF(I).DEPTH_PRESS
113	    FORMAT(F6.1)
	    PRF.PROF(I).DP_FLAG = INSTR(IST+6:IST+6)
	    READ(INSTR(IST+8:IST+16),114) PRF.PROF(I).PARM
114	    FORMAT(F9.3)
	    PRF.PROF(I).Q_PARM = INSTR(IST+17:IST+17)
	  ENDDO
C
C  Write the profile segments
	IF(ILIKE.EQ.1) THEN
	WRITE (6,5001) PRF.FXD.MKEY,PRF.FXD.IUMSGNO
5001	FORMAT (//' MKEY ',a10,'   IUMSGNO ',i10)
C
	WRITE (6,5003) PRF.FXD.ONE_DEG_SQ,PRF.FXD.CR_NUMBER,
     &   PRF.FXD.OBS_YEAR,PRF.FXD.OBS_MONTH,PRF.FXD.OBS_DAY,
     &   PRF.FXD.OBS_TIME
5003	FORMAT (' ONE_DEG_SQ',1X,I6,3X,'CR_NUMBER',1X,A14,2X,'OBS_DATE',
     &   1X,A4,2A2,3X,'OBS_TIME',1X,A4)
C
	WRITE (6,5004) PRF.FXD.DATA_TYPE,PRF.FXD.PROF_TYPE,
     &   PRF.FXD.PROFILE_SEG
5004	FORMAT (' DATA_TYPE',1X,A2,3X,' PROF_TYPE ',A4,3X,
     &   ' PROFILE_SEG ',A2)
C
	WRITE (6,5012) PRF.FXD.NO_DEPTHS,PRF.FXD.D_P_CODE,
     &   (PRF.PROF(I).DEPTH_PRESS,PRF.PROF(I).DP_FLAG,
     &   PRF.PROF(I).PARM,PRF.PROF(I).Q_PARM,
     &   I=1,PRF.FXD.NO_DEPTHS)
5012	FORMAT (/' NO_DEPTHS ',I5,3X,'D-P-CODE ',A1/
     &   ' - DEPTH_PRESS, DP_FLAG, PROF_PARM, ',
     &   'PROF_Q_PARM'/3(5X,F8.1,1X,A1,F10.4,1X,A1))
	ENDIF
	ENDDO
C
	NN=NN+1
	GO TO 1
C
999	CONTINUE
	PRINT 190,NN-1,NWR-1
190	FORMAT(' ',2I10,' STATIONS WERE READ AND OUTPUT')
	STOP
	END

Écriture de données dans les tables

	PROGRAM OCPROC_TO_TABLES
C	Reads binary format and writes contents to separate tables
C       for each structure
	CHARACTER STNNO*4, AKEY*17, CRN*10, DATETIME*10, OTIME*5, PD*10
	CHARACTER PDC*8, UDATE*10, STR*1, COMMA*1, STR1*5000
	DIMENSION STR(5000)
	EQUIVALENCE (STR1,STR)
C
	DICTIONARY 'CDD$TOP.APPLICATION.OCEAN.PROCESS_STN_REC/LIST'
	RECORD /PR_STN/STAT
	DICTIONARY 'CDD$TOP.APPLICATION.OCEAN.PROCESS_PROFILE_REC/LIST'
	RECORD /PR_PROFILE/PRF
C	
        OPEN(UNIT=1,STATUS='OLD',FORM='UNFORMATTED',
     &   RECORDTYPE='VARIABLE',READONLY,IOSTAT=IOS)
        IF(IOS.NE.0)OPEN(UNIT=1,STATUS='OLD',FORM='UNFORMATTED',
     &   READONLY,RECORDTYPE='VARIABLE',ORGANIZATION='INDEXED')
C 
	OPEN(UNIT=11,STATUS='NEW',FORM='FORMATTED',RECL=10000)
	OPEN(UNIT=12,STATUS='NEW',FORM='FORMATTED')
	OPEN(UNIT=13,STATUS='NEW',FORM='FORMATTED')
	OPEN(UNIT=14,STATUS='NEW',FORM='FORMATTED')
	OPEN(UNIT=15,STATUS='NEW',FORM='FORMATTED')
	OPEN(UNIT=16,STATUS='NEW',FORM='FORMATTED')
C
	COMMA = ','
	NWR=1
	NWRITE1 = 0
	NWRITE2 = 0
	NWRITE3 = 0
	NWRITE4 = 0
	NWRITE5 = 0
	NWRITE6 = 0
	NN=1
C
1	CONTINUE
	READ(1,END=999) STAT.FXD,
     &     (STAT.PROF(I),I=1,STAT.FXD.NO_PROF),
     &     (STAT.SURFACE(J),J=1,STAT.FXD.NPARMS),
     &     (STAT.SURF_CODES(K),K=1,STAT.FXD.SPARMS),
     &     (STAT.HISTORY(L),L=1,STAT.FXD.NUM_HISTS)
C
	WRITE(STNNO,4000) STAT.FXD.STN_NUMBER
4000	FORMAT(I4.4)
	IF(STAT.FXD.CR_NUMBER(10:10).EQ.' ') THEN 
	  CRN = ' '//STAT.FXD.CR_NUMBER(1:9)
	ELSE
	  CRN = STAT.FXD.CR_NUMBER
	ENDIF
	AKEY = CRN//'-'//STNNO//STAT.FXD.DATA_TYPE
	DATETIME = STAT.FXD.OBS_MONTH//'/'//STAT.FXD.OBS_DAY//
     &   '/'//STAT.FXD.OBS_YEAR
	OTIME = STAT.FXD.OBS_TIME(1:2)//':'//STAT.FXD.OBS_TIME(3:4)
	UDATE = STAT.FXD.UP_DATE(5:6)//'/'//STAT.FXD.UP_DATE(7:8)//
     &   '/'//STAT.FXD.UP_DATE(1:4)
C
	WRITE (STR1,4011) AKEY, COMMA, STAT.FXD.ONE_DEG_SQ, 
     &   COMMA, STAT.FXD.CR_NUMBER, COMMA,
     &   STAT.FXD.STN_NUMBER, COMMA, DATETIME, COMMA,
     &   STAT.FXD.OBS_MONTH, COMMA,
     &   OTIME, COMMA, STAT.FXD.DATA_TYPE, COMMA,
     &   STAT.FXD.LATITUDE, COMMA, STAT.FXD.LONGITUDE, COMMA,
     &   STAT.FXD.Q_POS, COMMA, STAT.FXD.Q_DATE_TIME, COMMA,
     &   STAT.FXD.Q_RECORD, COMMA, UDATE, COMMA, STAT.FXD.BUL_TIME,
     &   COMMA, STAT.FXD.BUL_HEADER, COMMA,
     &   STAT.FXD.SOURCE_ID, COMMA, STAT.FXD.STREAM_IDENT, COMMA,
     &   STAT.FXD.QC_VERSION, COMMA, STAT.FXD.AVAIL
4011	FORMAT (A20,A1,I7,A1,A11,A1,I4.4,A1,A11,A1,A3,A1,A6,A1,A3,
     &   A1,F10.4,A1,F10.4,6A2,A1,A11,
     &   A1,A13,A1,A7,3(A1,A5),2A2)
        CALL SQUEEZE(STR, NS)
	WRITE(11,4100) (STR(I),I=1,NS)
4100	FORMAT(5000A1)
	NWRITE1 = NWRITE1 + 1
C
	DO I=1,STAT.FXD.NPARMS
	WRITE (STR1,4013)  AKEY, COMMA,
     &   STAT.SURFACE(I).PCODE, COMMA, STAT.SURFACE(I).PARM, COMMA,
     &   STAT.SURFACE(I).Q_PARM
4013	FORMAT (A17,A1,A4,A1,F10.4,2A1)
        CALL SQUEEZE(STR, NS)
	WRITE(13,4100) (STR(II),II=1,NS)
	NWRITE3 = NWRITE3 + 1
	ENDDO
C
	DO I=1,STAT.FXD.SPARMS
	WRITE (STR1,4014) AKEY, COMMA,
     &   STAT.SURF_CODES(I).PCODE, COMMA, STAT.SURF_CODES(I).CPARM,
     &   COMMA, STAT.SURF_CODES(I).Q_PARM
4014	FORMAT (A17,A1,A4,A1,A10,2A1)
        CALL SQUEEZE(STR, NS)
	WRITE(14,4100) (STR(II),II=1,NS)
	NWRITE4 = NWRITE4 + 1
	ENDDO
C
	DO I=1,STAT.FXD.NUM_HISTS
	WRITE(PDC,4002) STAT.HISTORY(I).PRC_DATE
4002	FORMAT(I8)
	PD = PDC(5:6)//'/'//PDC(7:8)//'/'//PDC(1:4)
	WRITE (STR1,4015) AKEY, COMMA, I, COMMA,
     &   STAT.HISTORY(I).IDENT_CODE, COMMA, STAT.HISTORY(I).PRC_CODE, 
     &   COMMA, STAT.HISTORY(I).VERSION, COMMA, PD, COMMA,
     &   STAT.HISTORY(I).ACT_CODE, COMMA, STAT.HISTORY(I).ACT_PARM,
     &   COMMA, STAT.HISTORY(I).AUX_ID, COMMA,
     &   STAT.HISTORY(I).O_VALUE
        CALL SQUEEZE(STR, NS)
	WRITE(15,4100) (STR(II),II=1,NS)
	NWRITE5 = NWRITE5 + 1
	ENDDO
4015	FORMAT (A17,A1,I3.3,2A2,A1,A4,A1,A4,A1,A12,2A2,A1,A4,
     &   A1,F9.3,A1,F9.3)
	NWR=NWR+1
C
C  Count the number of profile segments to read
	NO_PRF = 0
	DO 20 I = 1,STAT.FXD.NO_PROF
	NO_PRF = NO_PRF + STAT.PROF(I).NO_SEG
20	CONTINUE
C
C  Read the profile segments
      DO 50 J=1,NO_PRF
	READ(1,END=999) PRF.FXD,
     &   (PRF.PROF(I),I=1,PRF.FXD.NO_DEPTHS)
C
C  Write the profile segments
	DO I=1,PRF.FXD.NO_DEPTHS
	WRITE (STR1,4016) AKEY, COMMA, PRF.FXD.PROF_TYPE, COMMA,
     &   PRF.PROF(I).DEPTH_PRESS, COMMA, PRF.PROF(I).DP_FLAG, COMMA,
     &   PRF.PROF(I).PARM, COMMA, PRF.PROF(I).Q_PARM
4016	FORMAT (A17,A1,A5,A1,F10.4,2A2,A1,F10.4,2A2)
        CALL SQUEEZE(STR, NS)
	WRITE(16,4100) (STR(II),II=1,NS)
	NWRITE6 = NWRITE6 + 1
	ENDDO
C
50	CONTINUE
C
	DO I=1,STAT.FXD.NO_PROF
	WRITE (STR1,4012) AKEY, COMMA,
     &   STAT.PROF(I).PROF_TYPE, COMMA,
     &   STAT.PROF(I).DUP_FLAG, COMMA, STAT.PROF(I).DIGIT_CODE, COMMA,
     &   STAT.PROF(I).STANDARD, COMMA, PRF.FXD.D_P_CODE, COMMA,
     &   STAT.PROF(I).DEEP_DEPTH
4012	FORMAT (A17,A1,A4,2A1,2A1,4A2,A1,F8.1)
        CALL SQUEEZE(STR, NS)
	WRITE(12,4100) (STR(II),II=1,NS)
	NWRITE2 = NWRITE2 + 1
	ENDDO
C
	NN=NN+1
c	IF(NN.LE.100) GO TO 1
	GO TO 1
C
999	CONTINUE
	PRINT 190,NN-1,NWR-1
190	FORMAT(' ',2I10,' STATIONS WERE READ AND OUTPUT')
	PRINT 198, NWRITE1, NWRITE2, NWRITE3, NWRITE4, NWRITE5, NWRITE6
198	FORMAT(' Number of rows written:',/,
     &   ' Station header: ',I20,/,
     &   ' Profile info:   ',I20,/,
     &   ' Surface info:   ',I20,/,
     &   ' SCodes info:    ',I20,/,
     &   ' History:        ',I20,/,
     &   ' Profile data:   ',I20)
	STOP
	END
C
        SUBROUTINE SQUEEZE(STR, NS)
C   Squeeze out imbedded blanks and remove trailing blanks and commas
        CHARACTER STR*1
        DIMENSION STR(3300)
C
        IDFLG = 0
        NSIZE = 3300
        NS = NSIZE
        DO I=1,NSIZE
          J = 1 + NSIZE - I
          IF(IDFLG.EQ.0) THEN
            IF(STR(J).EQ.' ') THEN
              NS = NS - 1
            ELSE
              IDFLG = 1
            ENDIF
          ELSE
            IF(STR(J).EQ.' ') THEN
              DO IJK = J,NS-1
                STR(IJK) = STR(IJK+1)
              ENDDO
              NS = NS - 1
            ENDIF
          ENDIF
        ENDDO
C
        RETURN
        END