First content

.gitignore

@@ -186,3 +186,8 @@ sympy-plots-for-*.tex/
 *.bak
 *.sav
 
+# Fortran module files
+*.mod
+
+# Notebooks
+notebooks/*.ipynb_checkpoints

README.md

@@ -5,5 +5,3 @@ This is the repository for the training Learning Fortran
 ### Instructor
 
 **Pierre-Yves Barriat**
-
-_Freelance Software Developer_

notebooks/03_dataxy

@@ -0,0 +1,61 @@
+   0.00000000       0.00000000    
+  0.100000001       9.98334214E-02
+  0.200000003      0.198669329    
+  0.300000012      0.295520216    
+  0.400000006      0.389418334    
+  0.500000000      0.479425550    
+  0.600000024      0.564642489    
+  0.699999988      0.644217670    
+  0.800000012      0.717356086    
+  0.900000036      0.783326924    
+   1.00000000      0.841470957    
+   1.10000002      0.891207397    
+   1.20000005      0.932039082    
+   1.30000007      0.963558197    
+   1.39999998      0.985449731    
+   1.50000000      0.997494996    
+   1.60000002      0.999573588    
+   1.70000005      0.991664827    
+   1.80000007      0.973847628    
+   1.89999998      0.946300089    
+   2.00000000      0.909297407    
+   2.10000014      0.863209307    
+   2.20000005      0.808496356    
+   2.29999995      0.745705247    
+   2.40000010      0.675463140    
+   2.50000000      0.598472118    
+   2.60000014      0.515501261    
+   2.70000005      0.427379847    
+   2.79999995      0.334988207    
+   2.90000010      0.239249244    
+   3.00000000      0.141120002    
+   3.10000014       4.15805206E-02
+   3.20000005      -5.83741926E-02
+   3.29999995     -0.157745644    
+   3.40000010     -0.255541205    
+   3.50000000     -0.350783229    
+   3.60000014     -0.442520559    
+   3.70000005     -0.529836178    
+   3.79999995     -0.611857831    
+   3.90000010     -0.687766254    
+   4.00000000     -0.756802499    
+   4.09999990     -0.818277061    
+   4.20000029     -0.871575892    
+   4.30000019     -0.916166008    
+   4.40000010     -0.951602101    
+   4.50000000     -0.977530122    
+   4.59999990     -0.993690968    
+   4.70000029     -0.999923289    
+   4.80000019     -0.996164620    
+   4.90000010     -0.982452571    
+   5.00000000     -0.958924294    
+   5.09999990     -0.925814748    
+   5.20000029     -0.883454502    
+   5.30000019     -0.832267344    
+   5.40000010     -0.772764444    
+   5.50000000     -0.705540299    
+   5.59999990     -0.631266713    
+   5.70000029     -0.550685287    
+   5.80000019     -0.464602023    
+   5.90000010     -0.373876572    
+   6.00000000     -0.279415488    

notebooks/03_gnuxy

@@ -0,0 +1,6 @@
+ set xlabel 'x'                                                                                                                                        
+ set xrange [0:6]
+ set ylabel 'y'                                                                                                                                        
+ set yrange [-1.2:1.2]
+ plot "03_dataxy" using 1:2 title 'sin(x)' with lines lt rgb "red"                                                                                     
+ pause -1

notebooks/Untitled.ipynb

@@ -0,0 +1,471 @@
+{
+ "cells": [
+  {
+   "cell_type": "markdown",
+   "id": "10d0e3c5",
+   "metadata": {},
+   "source": [
+    "## Introduction to structured programming with Fortran\n",
+    "\n",
+    "### Why to learn Fortran ?\n",
+    "\n",
+    "* Because of the execution speed of a program\n",
+    "* Well suited for numerical computations : more than **45% of scientific applications** are in Fortran\n",
+    "\n",
+    "### Getting started\n",
+    "\n",
+    "#### Hello World"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": null,
+   "id": "00ec1776",
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "program hello_world\n",
+    "\n",
+    "  implicit none ! important\n",
+    "\n",
+    "  print *, \"Hello World!\"\n",
+    "\n",
+    "end program hello_world"
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "id": "c4b788f0",
+   "metadata": {},
+   "source": [
+    "#### Data Type Declarations and Assignments"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": null,
+   "id": "ffd3f0c3",
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "program data_type\n",
+    "\n",
+    "  implicit none\n",
+    "  \n",
+    "  real x, y\n",
+    "  integer i, j\n",
+    "  logical flag\n",
+    "  \n",
+    "  integer matrix(2,2) \n",
+    "  character(80) month\n",
+    "  character(len=80) months(12)\n",
+    "  \n",
+    "  character family*16\n",
+    "  \n",
+    "  real, dimension(12) :: small_array\n",
+    "  character(len=80), dimension(24) :: screen\n",
+    "  \n",
+    "  integer, parameter :: it = 100\n",
+    "  \n",
+    "  i = 1\n",
+    "  j = i+2\n",
+    "  x = 85.8\n",
+    "  y = 3.5*cos(x)\n",
+    "\n",
+    "  month=\"december\"\n",
+    "  \n",
+    "  months(:)=\"empty\"\n",
+    "  \n",
+    "  months(12)=month\n",
+    "  \n",
+    "  flag = .TRUE.\n",
+    "  \n",
+    "  family = \"GEORGE P. BURDELL\"\n",
+    "  print*,family(:6)\n",
+    "  print*,family(8:9)\n",
+    "  print*,family(11:)\n",
+    "  print*,family(:6)//FAMILY(10:)\n",
+    "  \n",
+    "end"
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "id": "133046ed",
+   "metadata": {},
+   "source": [
+    "#### Arithmetic Assignments\n",
+    "\n",
+    "The result of any integer divide is truncated to the integer value less than the correct decimal answer for the division. The result of this is that changing the order of operations can make a big difference in the answers.  Notice how parentheses force more expected results."
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": null,
+   "id": "13343800",
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "program arith\n",
+    "\n",
+    "  implicit none\n",
+    "  \n",
+    "  real r2,r3,r4,r5,r6,ans1,ans2,ans3\n",
+    "  integer i2,i3,i4,i5,i6,ians1,ians2,ians3,ians4\n",
+    "  \n",
+    "  data r2/2./,r3/3./,r4/4.0/,r5/5.0/\n",
+    "  data i2,i3,i4,i5/2,3,4,5/\n",
+    "  \n",
+    "  ians1=i2*i3/i5\n",
+    "  ians2=i3/i5*i2\n",
+    "  ians3=i2*(i3/i5)\n",
+    "  ians4=(i3/i5)*i2\n",
+    "  print *, '2*3/5 =', ians1, ', 3/5*2 =',ians2,', 2*(3/5) =',ians3 ,', (3/5)*2 =',ians4\n",
+    "  \n",
+    "end program arith"
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "id": "cabea667",
+   "metadata": {},
+   "source": [
+    "Real arithmetic behaves more uniformly:"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": null,
+   "id": "e1de5730",
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "program arith\n",
+    "\n",
+    "  implicit none\n",
+    "  \n",
+    "  real r2,r3,r4,r5,r6,ans1,ans2,ans3\n",
+    "  integer i2,i3,i4,i5,i6,ians1,ians2,ians3,ians4\n",
+    "  \n",
+    "  data r2/2./,r3/3./,r4/4.0/,r5/5.0/\n",
+    "  data i2,i3,i4,i5/2,3,4,5/\n",
+    "  \n",
+    "  ans1=r2*r3/r5\n",
+    "  ans2=r3/r5*r2\n",
+    "  ans3=(r3/r5)*r2\n",
+    "  print *, '2.0*3.0/5.0 =', ans1, ', 3.0/5.0*2.0 =',ans2,', (3.0/5.0)*2.0 =',ans3\n",
+    "      \n",
+    "end program arith      "
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "id": "f18b85ec",
+   "metadata": {},
+   "source": [
+    "Watch how precedence of operations effects the following:"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": null,
+   "id": "9a362858",
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "program arith\n",
+    "\n",
+    "  implicit none\n",
+    "  \n",
+    "  real r2,r3,r4,r5,r6,ans1,ans2,ans3\n",
+    "  integer i2,i3,i4,i5,i6,ians1,ians2,ians3,ians4\n",
+    "  \n",
+    "  data r2/2./,r3/3./,r4/4.0/,r5/5.0/\n",
+    "  data i2,i3,i4,i5/2,3,4,5/\n",
+    "\n",
+    "  ians1=i2+i5*i3**i2\n",
+    "  ians2=i5*i3**i2+i2\n",
+    "  ians3=i3**i2*i5+i2\n",
+    "  print *, '2+5*3**2 =',ians1,', 5*3**2+2 =',ians2, ', 3**2*5+2 =',ians3\n",
+    "      \n",
+    "end program arith      "
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "id": "5297b017",
+   "metadata": {},
+   "source": [
+    "You can mix real and integers, but watch what happens"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": null,
+   "id": "7d50669e",
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "program arith\n",
+    "\n",
+    "  implicit none\n",
+    "  \n",
+    "  real r2,r3,r4,r5,r6,ans1,ans2,ans3\n",
+    "  integer i2,i3,i4,i5,i6,ians1,ians2,ians3,ians4\n",
+    "  \n",
+    "  data r2/2./,r3/3./,r4/4.0/,r5/5.0/\n",
+    "  data i2,i3,i4,i5/2,3,4,5/\n",
+    "\n",
+    "  ans1=r5+i3/i2\n",
+    "  ans2=5.0+3/2\n",
+    "  print *, '5.0+3/2 =',ans1\n",
+    "  print *, '5.0+3/2 =',ans2\n",
+    "      \n",
+    "end program arith      "
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "id": "222cabbc",
+   "metadata": {},
+   "source": [
+    "Look at what happens when I put a real in either the numerator or denominator of the division term"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": null,
+   "id": "78929c6e",
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "program arith\n",
+    "\n",
+    "  implicit none\n",
+    "  \n",
+    "  real r2,r3,r4,r5,r6,ans1,ans2,ans3\n",
+    "  integer i2,i3,i4,i5,i6,ians1,ians2,ians3,ians4\n",
+    "  \n",
+    "  data r2/2./,r3/3./,r4/4.0/,r5/5.0/\n",
+    "  data i2,i3,i4,i5/2,3,4,5/\n",
+    "\n",
+    "  ans1=r5+i3/r2\n",
+    "  ans2=r5+r3/i2\n",
+    "  print *, '5.0+3/2.0 =',ans1, ', 5.0+3.0/2 =', ans2\n",
+    "      \n",
+    "end program arith           "
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "id": "a7d37bc2",
+   "metadata": {},
+   "source": [
+    "Although Fortran normally works from left to right at a given level of precedence (does all multiply and divide from left to right before moving on to adds and subtracts). It works exponentiation from right to left when it hits 2 or more sequential exponentiation operations"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": null,
+   "id": "3c2da1a9",
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "program arith\n",
+    "\n",
+    "  implicit none\n",
+    "  \n",
+    "  real r2,r3,r4,r5,r6,ans1,ans2,ans3\n",
+    "  integer i2,i3,i4,i5,i6,ians1,ians2,ians3,ians4\n",
+    "  \n",
+    "  data r2/2./,r3/3./,r4/4.0/,r5/5.0/\n",
+    "  data i2,i3,i4,i5/2,3,4,5/\n",
+    "\n",
+    "  ians1= i5**i3**i2\n",
+    "  ians2= (i5**i3)**i2\n",
+    "  ians3= i5**(i3**i2)\n",
+    "  print *, '5**3**2 =',ians1, ', (5**3)**2 =',ians2,  ', 5**(3**2) =',ians3\n",
+    "      \n",
+    "end program arith           "
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "id": "8387be7a",
+   "metadata": {},
+   "source": [
+    "When in doubt use parentheses to get the answer that you really want.\n",
+    "\n",
+    "#### Assignments exercise"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": null,
+   "id": "14f6e7e2",
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "program sphere  \n",
+    "\n",
+    "  implicit none\n",
+    "      \n",
+    "      real pi,radius,volume,area  \n",
+    "          \n",
+    "      radius = 1.0\n",
+    "      pi = 0.0\n",
+    "      \n",
+    "      write(*,*) 'The value of pi is ', pi\n",
+    "      write(*,*) \n",
+    "\n",
+    "      area = 0.0\n",
+    "      volume = 0.0\n",
+    "      \n",
+    "      write(*,*) 'For a radius ', radius \n",
+    "      write(*,*) 'the area of a sphere is ', area\n",
+    "      write(*,*) 'and the volume is ', volume\n",
+    "      \n",
+    "end "
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "id": "9a1702f7",
+   "metadata": {},
+   "source": [
+    "#### Execution Control"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": null,
+   "id": "41f9a8f0",
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "PROGRAM gcd\n",
+    "  ! Computes the greatest common divisor, Euclidean algorithm\n",
+    "  IMPLICIT NONE\n",
+    "  INTEGER :: m, n, t\n",
+    "  WRITE(*,*) \"Give positive integers m and n :\"\n",
+    "  m=5464\n",
+    "  n=484682\n",
+    "  WRITE(*,*) 'm:', m,' n:', n\n",
+    "  positive_check: IF (m > 0 .AND. n > 0) THEN\n",
+    "    main_algorithm: DO WHILE (n /= 0)\n",
+    "      t = MOD(m,n)\n",
+    "      m = n\n",
+    "      n = t\n",
+    "    END DO main_algorithm\n",
+    "    WRITE(*,*) \"Greatest common divisor: \",m\n",
+    "  ELSE\n",
+    "    WRITE(*,*) 'Negative value entered'\n",
+    "  END IF positive_check\n",
+    "END PROGRAM gcd"
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "id": "cef2ad42",
+   "metadata": {},
+   "source": [
+    "#### File-Directed Input and Output"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": null,
+   "id": "8fd042c4",
+   "metadata": {},
+   "outputs": [],
+   "source": [
+    "program plot\n",
+    "\n",
+    "  ! Program to provide plots of Sin(x)\n",
+    "\n",
+    "  implicit none\n",
+    "  character label*150\n",
+    "  real x\n",
+    "  integer i\n",
+    "  character xlabel*32,ylabel*32,title*32\n",
+    "  real fx\n",
+    "  !\n",
+    "  ! label   -   Character string \n",
+    "  ! xlabel  -   Contains a label for the x-axis\n",
+    "  ! ylabel  -   Contains a label for the y-axis\n",
+    "  ! title   -   Contains a title for the plot\n",
+    "  !\n",
+    "  ! Drive a separate true graphics program (gnuplot)\n",
+    "  !\n",
+    "  ! First set up the command file for gnuplot\n",
+    "  !\n",
+    "  xlabel=\"'x'\"\n",
+    "  ylabel=\"'y'\"\n",
+    "  title=\"'sin(x)'\"\n",
+    "  open (112,file='03_gnuxy')\n",
+    "  !\n",
+    "  label='set xlabel '//xlabel\n",
+    "  write(112,*)label\n",
+    "  write(112,*)'set xrange [0:6]'\n",
+    "  label='set ylabel '//ylabel\n",
+    "  write(112,*)label\n",
+    "  write(112,*)'set yrange [-1.2:1.2]'\n",
+    "  label='plot \"03_dataxy\" using 1:2 title '//title\n",
+    "  label=trim(label)//' with lines lt rgb \"red\"'\n",
+    "  write(112,*) label\n",
+    "  write (112,*) 'pause -1'\n",
+    "  close(112)\n",
+    "  !\n",
+    "  !   Generate x-y pairs for the graph\n",
+    "  !\n",
+    "  open (112,file='03_dataxy')\n",
+    "  do i=0,60\n",
+    "    x=.1*i\n",
+    "    fx=sin(x)\n",
+    "    write(112,*) x,fx\n",
+    "  enddo\n",
+    "  close(112)\n",
+    "  !\n",
+    "end program"
+   ]
+  },
+  {
+   "cell_type": "markdown",
+   "id": "558d962e",
+   "metadata": {},
+   "source": [
+    "This code is going to create 2 files: \"03_dataxy\" and \"03_gnuxy\".\n",
+    "\n",
+    "The idea is to use a linux plotting tool called \"GNUplot\" to make a graph: the first file is the data for the graph, the second one is the gnuplot script using these data.\n",
+    "\n",
+    "```bash\n",
+    "gnuplot 03_gnuxy\n",
+    "```\n",
+    "\n",
+    "<img src=\"../assets/sin.png\">"
+   ]
+  },
+  {
+   "cell_type": "code",
+   "execution_count": null,
+   "id": "4b517d6b",
+   "metadata": {},
+   "outputs": [],
+   "source": []
+  }
+ ],
+ "metadata": {
+  "kernelspec": {
+   "display_name": "Fortran",
+   "language": "Fortran",
+   "name": "fortran_spec"
+  },
+  "language_info": {
+   "file_extension": "f90",
+   "mimetype": "text/plain",
+   "name": "fortran"
+  }
+ },
+ "nbformat": 4,
+ "nbformat_minor": 5
+}

src/00_hello_world.f

@@ -0,0 +1,8 @@
+      ! Ce programme affiche "Bonjour, le monde!"
+      program hello_world
+
+         implicit none ! important
+
+         print *, "Bonjour, le monde!"
+
+      end program hello_world

src/01_arith.f

@@ -0,0 +1,96 @@
+c
+c   Program to demonstrate Arithmetic Assignments
+c
+      program arith
+      implicit none
+c
+c     declare the data types for all Fortran variables
+c
+      real r2,r3,r4,r5,r6,ans1,ans2,ans3
+      integer i2,i3,i4,i5,i6,ians1,ians2,ians3,ians4
+c
+c     r2 thru r6 take on the real values 2.0 thru 6.0
+c
+c     i2 thru i6 take on the integer values 2 thru 6
+c
+c     ans1, ans2, and ans3 will contain the answers from
+c     real arithmetic
+c
+c     ians1 thru ians4 will contain the answers from
+c     integer arithmetic
+c
+c
+c     Set initial values of the variables with 2 valid forms
+c     of data statements
+      data r2/2./,r3/3./,r4/4.0/,r5/5.0/
+      data i2,i3,i4,i5/2,3,4,5/
+c
+c     This ends the non-executable statements, nothing above
+c     this point results in a machine instruction to perform
+c     some operation.
+c     Executable statements follow.
+c
+c     The result of any integer divide is truncated to the integer
+c     value less than the correct decimal answer for the division
+c     The result of this is that changing the order of operations
+c     can make a big difference in the answers.  Notice how parentheses
+c     force more expected results
+c
+      ians1=i2*i3/i5
+      ians2=i3/i5*i2
+      ians3=i2*(i3/i5)
+      ians4=(i3/i5)*i2
+      print *, '2*3/5 =', ians1, ', 3/5*2 =',ians2,
+     &  ', 2*(3/5) =',ians3 ,', (3/5)*2 =',ians4
+c
+c     Real arithmetic behaves more uniformly
+c
+      ans1=r2*r3/r5
+      ans2=r3/r5*r2
+      ans3=(r3/r5)*r2
+      print *, '2.0*3.0/5.0 =', ans1, ', 3.0/5.0*2.0 =',ans2,
+     &  ', (3.0/5.0)*2.0 =',ans3
+c
+c     Watch how precedence of operations effects the following:
+c
+      ians1=i2+i5*i3**i2
+      ians2=i5*i3**i2+i2
+      ians3=i3**i2*i5+i2
+      print *, '2+5*3**2 =',ians1,', 5*3**2+2 =',ians2,
+     & ', 3**2*5+2 =',ians3
+c
+c     You can mix real and integers, but watch what happens
+c
+      ans1=r5+i3/i2
+      print *, '5.0+3/2 =',ans1
+
+c
+c     You can do the same thing with constants in the expression
+c
+      ans2=5.0+3/2
+      print *, '5.0+3/2 =',ans2
+c
+c     Look at what happens when I put a real in either the numerator
+c     or denominator of the division term
+      ans1=r5+i3/r2
+      ans2=r5+r3/i2
+      print *, '5.0+3/2.0 =',ans1, ', 5.0+3.0/2 =', ans2
+c
+
+c     Although Fortran normally works from left to right at a given
+c     level of precedence (does all multiply and divide from left to
+c     right before moving on to adds and subtracts).  It works
+c     exponentiation from right to left when it hits 2 or more
+c     sequential exponentiation operations
+c
+      ians1= i5**i3**i2
+      ians2= (i5**i3)**i2
+      ians3= i5**(i3**i2)
+      print *, '5**3**2 =',ians1, ', (5**3)**2 =',ians2,
+     &  ', 5**(3**2) =',ians3
+c
+c    When in doubt use parentheses to get the answer that you
+c    really want.
+c
+      stop
+      end

src/02_sphere.f

@@ -0,0 +1,24 @@
+      PROGRAM sphere    
+      implicit none
+      
+      real pi,radius,volume,area  
+          
+      WRITE(*,*) 'Enter the value for the radius of a sphere.'
+      READ(*,*) radius
+ 
+ccccc PI value
+      pi =  
+ccccc PI value
+      WRITE(*,*) 'The value of pi is ', pi
+
+ccccc Air & volume       
+      area =
+      volume = 
+ccccc Air & volume 
+      
+      WRITE(*,*) 'For a radius ', radius 
+      WRITE(*,*) 'the area of a sphere is ', area
+      WRITE(*,*) 'and the volume is ', volume
+      
+      STOP
+      END

src/03_plot.f

@@ -0,0 +1,59 @@
+      program plot
+c
+c    Program to provide plots of Sin(x)
+c
+      implicit none
+      character label*150
+      real x
+      integer i
+      character xlabel*32,ylabel*32,title*32
+      real fx
+c
+c   label   -   Character string 
+c   xlabel  -   Contains a label for the x-axis
+c   ylabel  -   Contains a label for the y-axis
+c   title   -   Contains a title for the plot
+c
+c   Drive a separate true graphics program (gnuplot)
+c
+c   First set up the command file for gnuplot
+c
+      xlabel='''x'''
+      ylabel='''y'''
+      title="'sin(x)'"
+      open (112,file='03_gnuxy')
+c
+c     write(112,*) 'set term wxt size 800, 800'
+c
+      label='set xlabel '//xlabel
+      write(112,*)label
+      write(112,*)'set xrange [0:6]'
+      label='set ylabel '//ylabel
+      write(112,*)label
+      write(112,*)'set yrange [-1.2:1.2]'
+      label='plot "03_dataxy" using 1:2 title '//title
+      label=trim(label)//' with lines lt rgb "red"'
+      write(112,*) label
+      write (112,*) 'pause -1'
+      close(112)
+c
+c   Generate x-y pairs for the graph
+c
+      open (112,file='03_dataxy')
+      do 100 i=0,60
+         x=.1*i
+         fx=sin(x)
+         write(112,*) x,fx
+  100 continue
+      close(112)
+c
+      print *, ' Hit the Return (Enter) key to continue'
+c
+c   Tell the system to run the program gnuplot
+c   This call works on either IBM RS6000 or Sun, but is not part of
+c   the Fortran standard.
+c   Comment out the line if you aren't at a terminal with graphics
+c
+      call system ('gnuplot 03_gnuxy')
+      stop
+      end

src/04_newton.f

@@ -0,0 +1,39 @@
+      program newton
+
+        implicit none
+
+c   Use a Newton iteration to solve a polynomial equation
+c
+c    x     -    current approximation to the solution
+c    f     -    polynomial function
+c    df    -    derivative of f with respect to x
+c    xo    -    previous guess for solution
+c    eps   -    convergence criterion
+c    dx    -    change in solution approximation
+c    it    -    number of iterations
+c    itmax -    maximum number of iterations
+      
+        real 
+        integer 
+
+c     Now start executable fortran statements
+
+        x= 
+        do while ()
+          x=
+        end do
+
+      end
+
+c ******************************************************************************************
+
+      subroutine derivate(x,f,df)
+
+c   Evaluate the function f(x)=x**3+x-10
+c   also return the derivative of the function
+                                             
+        implicit none
+        real 
+
+      return
+      end

src/05_common.f

@@ -0,0 +1,36 @@
+c * * * *
+c syntaxe common
+c common /nom de la zone commune/ liste des variables
+c * * * * 
+
+      PROGRAM test_arg
+
+        implicit none
+        integer a,b,c
+
+        common /arg/ a,b,c
+
+        a = 2
+        c = 1
+
+        print *, 'Before the call:'
+        print *, 'a = ',a,', b = ',b,', c = ',c
+
+        call sub
+
+        print *, 'After the call:'
+        print *, 'a = ',a,', b = ',b,', c = ',c
+
+      END PROGRAM
+
+      SUBROUTINE sub
+
+        implicit none
+
+        integer a,b,c
+        common /arg/ a,b,c
+
+        b = a + c
+        c = c + 1
+       
+      END SUBROUTINE

src/06_module.f90

@@ -0,0 +1,35 @@
+MODULE arg
+ implicit none
+ integer :: a,b,c
+ real(8) :: x
+END MODULE arg
+
+! * * * * * * * 
+
+PROGRAM test_arg
+ USE arg
+ implicit none
+
+ a = 2
+ c = 1
+
+ write(*,*) 'Before the call:'
+ write(*,'(3(A5,I3))') ' a = ',a,', b = ',b,', c = ',c
+
+ call sub
+
+ write(*,*) 'After the call:'
+ write(*,'(3(A5,I3))') 'a = ',a,', b = ',b,', c = ',c
+
+END PROGRAM test_arg
+
+! * * * * * * * 
+
+SUBROUTINE sub
+ USE arg, only : a,b,c    ! seuls a b et c sont utiles
+ implicit none
+
+ b = a + c
+ c = c + 1
+
+END SUBROUTINE sub

src/07_namelist.def

@@ -0,0 +1,11 @@
+! Namelist definition
+
+&namlon   ! limitation on the longitude
+   lon_min   =        0   
+   lon_max   =      360 
+/
+
+&namlat   ! limitation on the latitude
+   lat_min   =      -90 
+   lat_max   =       90  
+/

src/07_namelist.f90

@@ -0,0 +1,33 @@
+PROGRAM test_namelist
+
+  implicit none
+
+  real*8 lon_min, lon_max, lat_min, lat_max
+
+  NAMELIST/namlon/ lon_min, lon_max
+  NAMELIST/namlat/ lat_min, lat_max
+
+  write(*,*) 'Before:'
+  call print_res(lon_min, lon_max, lat_min, lat_max)
+
+  open(161,file='07_namelist.def',status='old',form='formatted')
+  read(161,NML=namlon)
+
+  write(*,*) 'Between:'
+  call print_res(lon_min, lon_max, lat_min, lat_max)
+
+  read(161,NML=namlat)
+  close (161)
+
+  write(*,*) 'After:'
+  call print_res(lon_min, lon_max, lat_min, lat_max)
+
+END
+
+SUBROUTINE print_res(a,b,c,d)
+  implicit none
+  real*8, intent(in) :: a,b,c,d
+  write(*,'(4(A12,F6.2))') '  lon_min = ',a,', lon_max = ',b, &
+                          ', lat_min = ',c,', lat_max = ',d
+  RETURN
+END

src/08_OceanGrideChange.f90

@@ -0,0 +1,1353 @@
+module bloc_commun
+  implicit double precision (a-h,o-z)
+  integer, parameter :: imax=122
+  integer, parameter :: jmax=65
+  integer, parameter :: jsepar=50
+  integer, parameter :: jeq=28
+  real, parameter :: spv=-1.e+32
+  real, parameter :: spvMin=-1.5e+32
+  real, parameter :: spvMax=-0.5e+32
+  integer, parameter :: jmtt=60
+  integer, parameter :: imtt=120
+  real*4 wdata3D(imax,jmax,2) !2 parce qu'au pire c'est un vecteur (2 dimensions)
+  real*4 wdatai3D(imtt,jmtt,2)
+  REAL, PARAMETER :: xi1 = 28.500, dxi = 3.00
+  REAL, PARAMETER :: yj1 =-79.500, dyj = 3.00
+  integer, PARAMETER :: iberp =56 , ibera = 103
+  real xlon1, ylat1, dlat, dlong
+
+  !--DEFINITION OF CONSTANTS.
+  !  pi    : pi
+  !  radian: value of one radian in degrees.
+  !  degre : value of one degre in radian .
+  !  separ : facteur de separation entre spv / normal value.
+  real*4, parameter :: pi     = 4.0d0 * atan(1.0d0)
+  real*4, parameter :: radian = pi/180.0
+  real*4, parameter :: degre  = 180.0/pi
+  real*4, parameter :: untour = 360.0d0
+  real*4, parameter :: epsil = 0.1d-9
+  real*4, parameter :: zero = 0.0
+  real*4, parameter ::  one  = 1.0
+  real*4, parameter :: separ = 0.5 + epsil
+
+  !--DEFINITION OF ROTATION ANGLES
+
+  real*4, parameter :: alpha =    0.0
+  real*4, parameter :: beta  = -111.0
+
+  save
+end module bloc_commun
+
+subroutine check(status)
+  USE NETCDF
+  IMPLICIT NONE
+
+  INTEGER, INTENT (IN) :: status
+  if(status /= nf90_noerr) then 
+    write(*,*)"Error : ", trim(nf90_strerror(status))
+    stop 
+  end if
+end subroutine check  
+
+
+program OceanGrideChange
+  USE NETCDF
+  USE bloc_commun
+  IMPLICIT NONE
+
+  TYPE variable
+    CHARACTER(nf90_max_name) :: name
+    integer :: itype
+    integer :: netcdfId
+    integer :: OutnetcdfId
+    integer, dimension(:), allocatable :: dimIndex
+    integer, dimension(:), allocatable :: OutdimIndex
+    integer, dimension(:), allocatable :: dimSize
+    integer, dimension(:), allocatable :: dimStart
+    integer :: nbdim
+  END TYPE variable
+
+  integer, parameter :: mx=120
+  integer, parameter :: my=65
+  integer, parameter :: mz=20
+  real*4 wdatx(imax,jmax), wdaty(imax,jmax)
+  real*4 valgu(imtt,jmtt), valgv(imtt,jmtt)
+  real*4 :: ttlon(imtt)
+  real*4 :: ttlat(jmtt)
+  integer t, ii, n, k, l
+  integer :: j, i, jmin
+  integer :: returnval
+  character(nf90_max_name) :: inputfile, outputfile, ifnocompress_char
+  real ylon1,dylon,xlat1,dxlat
+
+  integer nio0p, njo0p
+
+  type(variable), dimension(:), allocatable :: listVariable, listVariable2
+  double precision, dimension(:,:,:), allocatable :: Value3D
+  double precision, dimension(:,:,:,:), allocatable :: Value4Du
+  double precision, dimension(:,:,:,:), allocatable :: Value4Dv
+  double precision, dimension(:,:,:,:), allocatable :: Value4Dalbq
+  double precision, dimension(:,:), allocatable :: Valueh
+  double precision, dimension(:), allocatable :: ValueVar
+
+  !variable pour l'ouverture ecriture du netcdf
+  integer :: intputID, outputID, outdimid, RecordDimID
+  integer :: unlimDimID, nbDim, nbVar, nbAtt
+  integer :: nbvarDim, dimSize, varID
+  integer :: variableType, outvarid
+  integer, dimension(nf90_max_var_dims) :: varDimID
+  character(nf90_max_name) :: varName, dimName, attName
+  integer, dimension(nf90_max_var_dims) :: CorrespTabDimID, InverseCorrespTabDimID
+  integer :: nbOutDim, nbOutVar
+  double precision, dimension(:), allocatable :: valueDbl
+  integer :: totaltime, nbexistvariable
+  integer :: deflate_level, ifnocompress_int
+  logical :: ifnocompress
+  deflate_level=1
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  !!!!              VARIABLE LIST            !!!!
+  !!!! Becarefull albq need to be at the top !!!!
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  allocate(listVariable(29))
+  !averaged lead fraction
+  listVariable(1)%name="albq"!(time, ptlat, ptlon) ;
+  listVariable(1)%itype=1
+  !averaged salinity
+  listVariable(2)%name="salt"!(time, tdepth, ptlat, ptlon)
+  listVariable(2)%itype=1
+  !averaged zonal velocity component
+  listVariable(3)%name="u"!(time, tdepth, pulat, pulon)
+  listVariable(3)%itype=2
+  !averaged meridional velocity component
+  listVariable(4)%name="v"!(time, tdepth, pulat, pulon) ;
+  listVariable(4)%itype=2
+  !averaged vertical velocity component
+  listVariable(5)%name="w"!(time, wdepth, ptlat, ptlon) ;
+  listVariable(5)%itype=1
+  !averaged zonal barotropic momentum
+  listVariable(6)%name="ubar"!(time, pulat, pulon) ;
+  listVariable(6)%itype=2
+  !averaged meridional barotropic momentum
+  listVariable(7)%name="vbar"!(time, pulat, pulon) ;
+  listVariable(7)%itype=2
+  !averaged sea surface height
+  listVariable(8)%name="ssh"!(time, ptlat, ptlon) ;
+  listVariable(8)%itype=1
+  !averaged SST
+  listVariable(9)%name="sst"!(time, ptlat, ptlon) ;
+  listVariable(9)%itype=1
+  !averaged sea surface salinity
+  listVariable(10)%name="sss"!(time, ptlat, ptlon) ;
+  listVariable(10)%itype=1
+  !averaged surface heat flux
+  listVariable(11)%name="shflx"!(time, ptlat, ptlon) ;
+  listVariable(11)%itype=1
+  !averaged surface freshwater flux
+  listVariable(12)%name="sfflx"!(time, ptlat, ptlon) ;
+  listVariable(12)%itype=1
+  !averaged depth of ocean surface mixed layer
+  listVariable(13)%name="zmix"!(time, ptlat, ptlon) ;
+  listVariable(13)%itype=1
+  !averaged depth of convection
+  listVariable(14)%name="zcnv"!(time, ptlat, ptlon) ;
+  listVariable(14)%itype=1
+  !averaged G-M slope
+  listVariable(15)%name="msl"!(time, ptlat, ptlon) ;
+  listVariable(15)%itype=1
+  !averaged ice thickness
+  listVariable(16)%name="hice"!(time, ptlat, ptlon) ;
+  listVariable(16)%itype=1
+  !averaged ice production
+  listVariable(17)%name="hicp"!(time, ptlat, ptlon) ;
+  listVariable(17)%itype=1
+  !averaged snow thickness
+  listVariable(18)%name="hsn"!(time, ptlat, ptlon) ;
+  listVariable(18)%itype=1
+  !averaged snow precipitation
+  listVariable(19)%name="snow"!(time, ptlat, ptlon) ;
+  listVariable(19)%itype=1
+  !averaged ice temperature
+  listVariable(20)%name="tice"!(time, ptlat, ptlon) ;
+  listVariable(20)%itype=1
+  !averaged heat flux at ice base
+  listVariable(21)%name="fb"!(time, ptlat, ptlon) ;
+  listVariable(21)%itype=1
+  !averaged zonal ice velocity
+  listVariable(22)%name="uice"!(time, pulat, pulon) ;
+  listVariable(22)%itype=2
+  !averaged meridional ice velocity
+  listVariable(23)%name="vice"!(time, pulat, pulon) ;
+  listVariable(23)%itype=2
+  !averaged zonal wind stress
+  listVariable(24)%name="wsx"!(time, pulat, pulon) ;
+  listVariable(24)%itype=1
+  !averaged meridional wind stress
+  listVariable(25)%name="wsy"!(time, pulat, pulon) ;
+  listVariable(25)%itype=1
+  !meridional overturning streamfunction
+  listVariable(26)%name="moc"!(time, sfdepth, sflat, basidx) ;
+  listVariable(26)%itype=0
+  !meridional heat transport
+  listVariable(27)%name="mht"!(time, sflat, basidx) ;
+  listVariable(27)%itype=0
+  !meridional salt transport
+  listVariable(28)%name="mst"!(time, sflat, basidx) ;
+  listVariable(28)%itype=0
+  !averaged potential temperature
+  listVariable(29)%name="temp"!(time, tdepth, ptlat, ptlon)
+  listVariable(29)%itype=1
+
+  !get argument for filename
+  ifnocompress=.FALSE.
+  call getarg(1,inputfile)
+  call getarg(2,outputfile)
+  call getarg(3,ifnocompress_char)
+  read (ifnocompress_char,'(I1)') ifnocompress_int
+  if(ifnocompress_int.eq.1) then
+    ifnocompress=.TRUE.
+  endif
+  write(*,'(A,L)') "No compression = ",ifnocompress
+
+
+
+
+  dlat=dyj
+  dlong=dxi
+  xlon1=xi1
+  ylat1=yj1
+  nio0p=imtt
+  njo0p=jmtt
+  call gridtt(ttlon,ttlat,imtt,jmtt)
+  xlat1=ttlat(1)
+  dxlat=ttlat(2)-ttlat(1)
+  ylon1=ttlon(1)
+  dylon=ttlon(2)-ttlon(1)
+
+
+
+
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!
+  !!!! OPEN INPUT FILE !!!!
+  !!!!!!!!!!!!!!!!!!!!!!!!!
+  call check(nf90_open(inputfile, nf90_nowrite, intputID))
+  call check(nf90_inquire(intputID, nbDim, nbVar,  unlimitedDimId = unlimDimID))
+
+  !get totaltime
+  call check(nf90_inquire(intputID, unlimitedDimId = RecordDimID))
+  call check(nf90_inquire_dimension(intputID, RecordDimID, len = dimSize))
+  totaltime=dimSize
+  write(*,'(A,I2)') "Total time in the file = ", totaltime
+
+  !compte combien de variable de la la liste existe dans le fichier input
+  nbexistvariable=0
+  do i=1, size(listVariable)
+    if(nf90_inq_varid(intputID, listVariable(i)%name, varID).eq.nf90_noerr) nbexistvariable=nbexistvariable+1
+  enddo
+
+  !load variable architecture
+  write(*,'(A)') "Variable find in the input file ( idx) name ):"
+  allocate(listVariable2(nbexistvariable))
+  j=1
+  do i=1, size(listVariable)
+    if(nf90_inq_varid(intputID, listVariable(i)%name, varID).eq.nf90_noerr) then
+      listVariable2(j)%name=listVariable(i)%name
+      listVariable2(j)%itype=listVariable(i)%itype
+      call check(nf90_inquire_variable(intputID, varID, varName, ndims = nbvarDim, dimids = varDimID))
+      if(varName.eq.listVariable2(j)%name) then
+        listVariable2(j)%netcdfId=varID
+        allocate(listVariable2(j)%dimIndex(nbvarDim))
+        listVariable2(j)%dimIndex(:)=varDimID(1:nbvarDim)
+        allocate(listVariable2(j)%dimSize(nbvarDim))
+        allocate(listVariable2(j)%dimStart(nbvarDim))
+        do k=1, nbvarDim
+          call check(nf90_inquire_dimension(intputID, varDimID(k), len = dimSize))
+          listVariable2(j)%dimSize(k)=dimSize
+          listVariable2(j)%dimStart(k)=1
+        enddo
+        listVariable2(j)%nbdim=nbvarDim
+        write(*,'(A3,I3,A2,A)') '   ', listVariable2(j)%netcdfId, ') ', trim(listVariable2(j)%name)
+        !write(*,'(4(I3))')listVariable2(j)%dimIndex
+        j=j+1
+      endif
+    endif
+  enddo
+
+
+  !constuire le tableau de correspondance d'index de dimension entre le fichier d'entree et de sortie
+  write(*,'(A)',ADVANCE='NO') "Construct index table..."
+  CorrespTabDimID=-1
+  InverseCorrespTabDimID=0
+  l=3 !commence à trois parce que 1 et 2 sont le nouveau lon et lat
+  do i=1,size(listVariable2)
+    if(listVariable(i)%itype.ne.0) then
+      jmin=3
+      InverseCorrespTabDimID(listVariable2(i)%dimIndex(1))=1
+      InverseCorrespTabDimID(listVariable2(i)%dimIndex(2))=2
+    else
+      jmin=1
+    endif
+    do j=jmin, size(listVariable2(i)%dimIndex)
+      k=1
+      do while(CorrespTabDimID(k).ne.listVariable2(i)%dimIndex(j))
+        k=k+1
+        if(k.gt.nf90_max_var_dims) exit
+      enddo
+      if(k.eq.nf90_max_var_dims+1) then
+        CorrespTabDimID(l)=listVariable2(i)%dimIndex(j)
+        InverseCorrespTabDimID(listVariable2(i)%dimIndex(j))=l
+        l=l+1
+      endif
+    enddo
+  enddo
+  nbOutDim=l-1
+  nbOutVar=0
+  write(*,*) "OK"
+
+
+  write(*,'(A)') "Create output file header :"
+  !write target file
+  if(ifnocompress) then
+    call check(nf90_create(trim(outputfile), NF90_CLASSIC_MODEL, outputID))
+  else
+    call check(nf90_create(trim(outputfile), nf90_hdf5, outputID))
+  endif
+
+  !define dimension, variable associated and attribut
+  write(*,'(A)',ADVANCE='NO') "   Define dimensions and copy attributs..."
+  call check(nf90_inquire(intputID, unlimitedDimId = RecordDimID))
+  do i=1, nbOutDim
+    !get name and size of dimension
+    if(i.eq.1) then
+      dimName="lon"
+      dimSize=120
+    elseif(i.eq.2) then
+      dimName="lat"
+      dimSize=60
+    else
+      call check(nf90_inquire_dimension(intputID, CorrespTabDimID(i), name = dimName, len = dimSize))
+    endif
+
+    !define dimension with separation between unlimited and normal dimension
+    if(CorrespTabDimID(i).eq.RecordDimID) then
+      call check(nf90_def_dim(outputID, dimName, NF90_UNLIMITED, outdimid))
+    else
+      call check(nf90_def_dim(outputID, dimName, dimSize, outdimid))
+    endif
+
+    !define variable associate to dimension and copy/create attribus
+    if(i.eq.1) then
+      if(ifnocompress) then
+        call check(nf90_def_var(outputID, "lon", NF90_FLOAT, (/ 1 /), outvarid))
+      else
+        call check(nf90_def_var(outputID, "lon", NF90_FLOAT, (/ 1 /), outvarid, shuffle = .TRUE., deflate_level=deflate_level))
+      endif
+      call check(nf90_put_att(outputID, outvarid, "long_name", "longitude coordinate"))
+      call check(nf90_put_att(outputID, outvarid, "standard_name", "longitude"))
+      call check(nf90_put_att(outputID, outvarid, "units", "degrees_east"))
+      call check(nf90_put_att(outputID, outvarid, "axis", "X"))
+      nbOutVar=nbOutVar+1
+    elseif(i.eq.2) then
+      if(ifnocompress) then
+        call check(nf90_def_var(outputID, "lat", NF90_FLOAT, (/ 2 /), outvarid))
+      else
+        call check(nf90_def_var(outputID, "lat", NF90_FLOAT, (/ 2 /), outvarid, shuffle = .TRUE., deflate_level=deflate_level))
+      endif
+      call check(nf90_put_att(outputID, outvarid, "long_name", "latitude coordinate"))
+      call check(nf90_put_att(outputID, outvarid, "standard_name", "latitude"))
+      call check(nf90_put_att(outputID, outvarid, "units", "degrees_north"))
+      call check(nf90_put_att(outputID, outvarid, "axis", "Y"))
+      nbOutVar=nbOutVar+1
+    else
+      call check(nf90_inq_varid(intputID, dimName, varID))
+      call check(nf90_inquire_variable(intputID, varID, xtype = variableType, nAtts =nbAtt))
+      if(ifnocompress) then
+        call check(nf90_def_var(outputID, dimName, variableType, (/ i /), outvarid))
+      else
+        call check(nf90_def_var(outputID, dimName, variableType, (/ i /), outvarid, shuffle = .TRUE., deflate_level=deflate_level))
+      endif
+      do j=1, nbAtt
+        call check(nf90_inq_attname(intputID, varID, j, attName))
+        call check(nf90_copy_att(intputID, varID, attName, outputID, outvarid))
+      enddo
+      nbOutVar=nbOutVar+1
+    endif
+  enddo
+  write(*,*) "OK"
+
+
+  !define variable from the list
+  write(*,'(A)',ADVANCE='NO') "   Define variables and copy attributs..."
+  do i=1, size(listVariable2)
+    allocate(listVariable2(i)%OutdimIndex(size(listVariable2(i)%dimIndex)))
+    do j=1, size(listVariable2(i)%dimIndex)
+      listVariable2(i)%OutdimIndex(j)=InverseCorrespTabDimID(listVariable2(i)%dimIndex(j))
+    enddo
+
+    call check(nf90_inquire_variable(intputID, listVariable2(i)%netcdfId, nAtts =nbAtt))
+    if(ifnocompress) then
+      call check(nf90_def_var(outputID, listVariable2(i)%name, NF90_DOUBLE, listVariable2(i)%OutdimIndex, outvarid))
+    else
+      call check(nf90_def_var(outputID, listVariable2(i)%name, NF90_DOUBLE, listVariable2(i)%OutdimIndex, outvarid, shuffle = .TRUE., deflate_level=deflate_level))
+    endif
+    listVariable2(i)%OutnetcdfId=outvarid
+    !and copy attribus
+    do j=1, nbAtt
+      call check(nf90_inq_attname(intputID, listVariable2(i)%netcdfId, j, attName))
+      call check(nf90_copy_att(intputID, listVariable2(i)%netcdfId, attName, outputID, listVariable2(i)%OutnetcdfId))
+    enddo
+  enddo
+  nbOutVar=nbOutVar+size(listVariable2)
+  write(*,*) "OK"
+
+
+  !finish the configuration of the output file and starting put data
+  write(*,'(A)',ADVANCE='NO') "   Close definition mode..."
+  call check(nf90_enddef(outputID))
+  write(*,*) "OK"
+
+  !copy dimension data
+  write(*,'(A)',ADVANCE='NO') "Copy dimensions in output file..."
+  call check(nf90_inquire(intputID, unlimitedDimId = RecordDimID))
+  do i=1, nbOutDim
+    if(i.eq.1) then
+      call check(nf90_put_var(outputID, i, ttlon, (/ 1 /), (/ 120 /)))
+    elseif(i.eq.2) then
+      call check(nf90_put_var(outputID, i, ttlat, (/ 1 /), (/ 60 /)))
+    else
+      call check(nf90_inquire_dimension(intputID, CorrespTabDimID(i), name = dimName, len = dimSize))
+      call check(nf90_inq_varid(intputID, dimName, varID))
+      call check(nf90_inquire_variable(intputID, varID, xtype = variableType, nAtts =nbAtt))
+      do j=1, nbOutVar
+        returnval=nf90_inq_varid(outputID, dimName, outvarid)
+        if(outvarid.ne.-1) exit
+      enddo
+      allocate(valueDbl(dimSize))
+      call check(nf90_get_var(intputID, varID, valueDbl, (/ 1 /), (/ dimSize /)))
+      call check(nf90_put_var(outputID, outvarid, valueDbl, (/ 1 /), (/ dimSize /)))
+      deallocate(valueDbl)
+    endif
+  enddo
+  write(*,*) "OK"
+
+
+  !copy data already interpolate
+  write(*,'(A)',ADVANCE='NO') "Copy variable already interpolate..."
+  do n=1, size(listVariable2)
+    if(listVariable2(n)%itype.eq.0) then
+      call check(nf90_inq_varid(intputID, listVariable2(n)%name, varID))
+      call check(nf90_inquire_variable(intputID, listVariable2(n)%netcdfId, xtype = variableType, nAtts =nbAtt))
+      listVariable2(n)%dimSize(listVariable2(n)%nbdim)=1
+      allocate(valueDbl(product(listVariable2(n)%dimSize)))
+      do t=1, totaltime
+        listVariable2(n)%dimStart(listVariable2(n)%nbdim)=t
+        call check(nf90_get_var(intputID, varID, valueDbl, listVariable2(n)%dimStart, listVariable2(n)%dimSize))
+        call check(nf90_put_var(outputID, listVariable2(n)%OutnetcdfId, valueDbl, listVariable2(n)%dimStart, listVariable2(n)%dimSize))
+      enddo
+      deallocate(valueDbl)
+    endif
+  enddo
+  write(*,*) "OK"
+
+
+  !get h value for undef verification
+  write(*,'(A)') "Get undef zone..."
+  call check(nf90_inq_varid(intputID, "h", varID))
+  allocate(ValueVar(120*65))
+  call check(nf90_get_var(intputID, varID, ValueVar, start = (/1,1/), count = (/120,65/)))
+  allocate(Valueh(120,65))
+  Valueh=reshape(ValueVar, (/120,65/))
+  deallocate(ValueVar)
+  write(*,*) "OK"
+
+  !Open data time by time and process
+  write(*,'(A)') "Processing..."
+  allocate(Value4Dalbq(120, 65, 1, 1))
+  allocate(Value3D(120, 65, 1))
+  do t=1,totaltime
+    write(*,'(A,I5,A,I5,A)',ADVANCE='NO') "   t = ", t, '/', totaltime, ' '
+    n=1
+    do while(n.le.size(listVariable2))
+
+      !affichage de progression
+      if(listVariable2(n)%itype.eq.0) then
+        write(*,'(A)',ADVANCE='NO') '*'
+      elseif(listVariable2(n)%itype.eq.1) then
+        write(*,'(A)',ADVANCE='NO') '.'
+      else
+        write(*,'(A)',ADVANCE='NO') '^'
+      endif
+
+
+      if (listVariable2(n)%itype.ne.0) then !n'interpole pas le type 0
+        varName=listVariable2(n)%name
+
+        !call CF_READ2D(TRIM(name, varName, tk, imax-2, jmax, 1, w1)
+        !limite la dimension temporelle pour lire pas de temps par pas de temps
+        listVariable2(n)%dimStart(listVariable2(n)%nbdim)=t
+        listVariable2(n)%dimSize(listVariable2(n)%nbdim)=1
+
+        !initialise le pointeur de donnee monodimensionnel
+        allocate(ValueVar(product(listVariable2(n)%dimSize)))
+
+        !lit la variable
+        call check(nf90_get_var(intputID, listVariable2(n)%netcdfId, ValueVar, start = listVariable2(n)%dimStart, count = listVariable2(n)%dimSize))
+
+        !verifie si 3D ou 4D et reshape en conséquense pour stoquer dans value4D
+        if(listVariable2(n)%nbdim.eq.3) then
+          allocate(Value4Du(120, 65, 1, 1))
+          Value3D=reshape(ValueVar, (/120,65,1/))
+          Value4Du(:,:,1,:)=Value3D(:,:,:)
+        else
+          allocate(Value4Du(120, 65, listVariable2(n)%dimSize(3), 1))
+          Value4Du=reshape(ValueVar, (/120,65,listVariable2(n)%dimSize(3),1/))
+        endif
+        deallocate(ValueVar)
+
+        !storage albq like reference variable for other
+        if(varName.eq."albq") then
+          Value4Dalbq=Value4Du
+        endif
+
+        !open also the next variable if it's a vector type
+        if (listVariable2(n)%itype.eq.2) then
+          varName=listVariable2(n+1)%name
+          listVariable2(n+1)%dimStart(listVariable2(n+1)%nbdim)=t
+          listVariable2(n+1)%dimSize(listVariable2(n+1)%nbdim)=1
+          allocate(ValueVar(product(listVariable2(n+1)%dimSize)))
+          call check(nf90_get_var(intputID, listVariable2(n+1)%netcdfId, ValueVar, start = listVariable2(n+1)%dimStart, count = listVariable2(n+1)%dimSize))
+
+          if(listVariable2(n+1)%nbdim.eq.3) then
+            allocate(Value4Dv(120, 65, 1, 1))
+            Value3D=reshape(ValueVar, (/120,65,1/))
+            Value4Dv(:,:,1,:)=Value3D(:,:,:)
+          else
+            allocate(Value4Dv(120, 65, listVariable2(n)%dimSize(3), 1))
+            Value4Dv=reshape(ValueVar, (/120,65,listVariable2(n)%dimSize(3),1/))
+          endif
+          deallocate(ValueVar)
+        endif
+
+        !chaque profondeur est traité indépendament
+        do k=1, size(Value4Du,3)
+
+          !si pas assez de glace met à zero et verifie les valeurs undef
+          do i=1,120
+            do j=1,65
+              if(Valueh(i,j).lt.-0.9e+32) then
+                Value4Du(i,j,k,1)=spv
+                if(allocated(Value4Dv)) Value4Dv(i,j,k,1)=spv
+              elseif(Value4Dalbq(i,j,1,1).lt.0.05) then !! si pas assez glace on met à zero
+                if( (varName.eq."hice").or.(varName.eq."hicp").or.(varName.eq."hsn").or.(varName.eq."snow").or.(varName.eq."tice").or.(varName.eq."uice").or.(varName.eq."vice") ) then
+                  Value4Du(i,j,k,1)=0.0
+                  if(allocated(Value4Dv)) Value4Dv(i,j,k,1)=0.0
+                endif
+              endif
+            enddo
+          enddo
+
+          wdata3D(:,:,1)=Value4Du(:,:,k,1)
+          wdata3D(121,:,1)=Value4Du(1,:,k,1)
+          wdata3D(122,:,1)=Value4Du(2,:,k,1)
+          if(allocated(Value4Dv)) then
+            wdata3D(:,:,2)=Value4Dv(:,:,k,1)
+            wdata3D(121,:,2)=Value4Dv(1,:,k,1)
+            wdata3D(122,:,2)=Value4Dv(2,:,k,1)
+          else
+            wdata3D(:,:,2)=0.0
+          endif
+
+
+          !cyclic correspondance
+          do j=2,jeq
+            wdata3D(1,j,:) = wdata3D(imax-1,j,:) !1<-121 (grille 120 65)
+            wdata3D(imax,j,:) = wdata3D(2,j,:)
+            do ii=ibera-5,ibera+5
+              wdata3D(ii,jmax,:) = spv
+            enddo
+            do ii=iberp-5,iberp+5
+              wdata3D(ii,jsepar,:) = spv
+            enddo
+          enddo
+
+
+          !
+          ! Interpolation
+          !
+          if (listVariable2(n)%itype.eq.2) then
+            do i=1,imax
+              do j=1,jmax
+                wdatx(i,j)=wdata3D(i,j,1) !composante 1 vecteur
+                wdaty(i,j)=wdata3D(i,j,2) !composante 2 vecteur
+              enddo
+            enddo
+            call mercatv(ttlon,ttlat,wdatx,wdaty,valgu,valgv) 
+            do i=1,imtt
+              do j=1,jmtt
+                wdatai3D(i,j,1)=valgu(i,j)
+                wdatai3D(i,j,2)=valgv(i,j)
+              enddo
+            enddo
+
+            !Put interpolate data in output file
+            if(listVariable2(n)%nbdim.eq.3) then
+              call check(nf90_put_var(outputID, listVariable2(n)%OutnetcdfId, wdatai3D(:,:,1), (/1,1,t/),  (/imtt,jmtt,1/)))
+              call check(nf90_put_var(outputID, listVariable2(n+1)%OutnetcdfId, wdatai3D(:,:,2), (/1,1,t/),  (/imtt,jmtt,1/)))
+            else
+              call check(nf90_put_var(outputID, listVariable2(n)%OutnetcdfId, wdatai3D(:,:,1), (/1,1,k,t/),  (/imtt,jmtt,1,1/)))
+              call check(nf90_put_var(outputID, listVariable2(n+1)%OutnetcdfId, wdatai3D(:,:,2), (/1,1,k,t/),  (/imtt,jmtt,1,1/)))
+            endif
+          else
+            call mercat(ttlon,ttlat)
+            !Put interpolate data in output file
+            if(listVariable2(n)%nbdim.eq.3) then
+              call check(nf90_put_var(outputID, listVariable2(n)%OutnetcdfId, wdatai3D(:,:,1), (/1,1,t/),  (/imtt,jmtt,1/)))
+            else
+              call check(nf90_put_var(outputID, listVariable2(n)%OutnetcdfId, wdatai3D(:,:,1), (/1,1,k,t/),  (/imtt,jmtt,1,1/)))
+            endif
+          endif
+
+
+
+        enddo
+        deallocate(Value4Du)
+        if(allocated(Value4Dv)) deallocate(Value4Dv)
+      endif
+      if (listVariable2(n)%itype.eq.2) then
+        n=n+2
+      else
+        n=n+1
+      endif
+    enddo
+    write(*,*)
+  enddo
+
+
+  !close output file
+  call check(nf90_close(outputID))
+
+  write(*,*)'End of OceanGrideChange'
+  write(*,*)'--------------------------------------'
+end program OceanGrideChange
+
+subroutine mercat(ttlon,ttlat)
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+  !--INTERPOLATION OF SCALAR DATA PLACED AT THE CENTER OF THE
+  !--ELEMENTS OF A TWO RECTANGULAR GRID ONTO ONE GRID.
+  !--LONGITUDE-LATITUDE COORDINATES FOR BOTH GRIDS.
+  !--DATA ARE OUTPUTS OF THE PROGRAM OTI.
+  !--This subroutine is identical to mercat.f except for input and ouputs
+  !
+  !--M.A.Morales Maqueda, 11-IV-1994.
+  !--modified by H.GOOSSE 15-IV-1994
+  !--modified by H.GOOSSE + M.A.M. Maqueda 15-IV-1994
+  !--modified by H.GOOSSE 16-V-1994
+  !  modif : 14/10/94
+
+  !--(alpha,beta): (latitude,longitude) of the north pole of the new grid.
+  !
+  USE bloc_commun
+
+  integer, parameter :: nsmax = 2
+  integer :: jm, i, j
+
+  real*4 :: ttlon(imtt)
+  real*4 :: ttlat(jmtt)
+
+  integer :: gxw, iwp, jwp, nprt
+  real*4 ::  xaj1, yai1, dxaj, dyai, dxw, dyw, xxx, yyy, du, dd, dr, dl
+  real*4 :: dsxw, dsyw, dcxw, dcyw, dxa, dya, nn0, nn1, xw, yw, rd, ru, rr, rl, unsdtx, unsdty
+  real*4 :: gwlon(0:imax), galat(0:imax)
+  real*4 :: gwlat(0:jmax+1), galon(0:jmax+1)
+  real*4 :: valad, valcd, valau, valc, valcu, valcl, valcr
+  real*4 :: val(0:imax,0:jmax+1)
+  real*4 :: whigri(imtt,jmtt)
+
+
+
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+
+  1001  format(A32,1x,E13.6,1x,I6,1x,I6,1x,I6,1x,I6)
+  1000  format(A30,1x,E13.6,1x,I6,1x,I6,1x,I6,1x,I6)
+  1111  format(3(F7.2,1X,F7.3,1X),I3,A)
+
+  jm=jmax
+
+
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+  !  3 ) definition de la nouvelle grille .                              |
+  !-----------------------------------------------------------------------
+
+  !-----
+  !--DEFINE INTERPOLATING GRID WW.
+  !
+  !     call gridtt(ttlon,ttlat,imtt,jmtt)
+
+  !--DEFINE ORIGINAL GRIDS.
+  !----
+  xaj1 =  90. + yj1
+  yai1 =  90. + beta + untour - xi1
+  dxaj = dyj
+  dyai = -dxi
+  do i=0,imax
+    gwlon(i) = xi1 + dxi * DFLOAT(i-1)
+    galat(i) = 90. + beta + untour - gwlon(i)
+  enddo
+  do j=0,jmax+1
+    gwlat(j) = yj1 + dyj * DFLOAT(j-1)
+    galon(j) = 90. + gwlat(j)
+  enddo
+
+  !        write(6,*) 'galon :'
+  !        write(6,'(20F6.1)') (galon(j),j=0,jmax+1)
+  !        write(6,*) 'galat :'
+  !        write(6,'(20F6.1)') (galat(i),i=0,imax)
+
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+
+  !--COOMPUTE DE CORRESPONDANCE BETWEEN GRIDS
+
+  call choiceg(ttlat,ttlon,imtt,jmtt,whigri)
+
+  !       open (15,file='choiceg.dat')
+  !       do 350 j=1,jmtt
+  ! !       write(15,'(122(F8.3))') (whigri(i,j),i=1,imtt)
+  !         write(15,'(122(i1))') (int(whigri(i,j)),i=1,imtt)
+  !  350  continue
+  !       close (15)
+
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+  !  4 ) Traitement de la nouvelle grille colonne par colonne .          |
+  !-----------------------------------------------------------------------
+
+  !--MAIN DO-LOOP.
+
+  do j=1,jmtt
+    do i=1,imtt
+      !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+      !--debut du traitement de la colonne (i,j) :
+      if (whigri(i,j).eq.1.) then
+        dxw = ttlon(i)
+        dyw = ttlat(j)
+        gxw = xi1 + mod(dxw-xi1+untour, untour)
+        xxx = ( gxw - xi1 ) / dxi + 0.5
+        iwp = nint(xxx) 
+        iwp = max(0,min(imax-1,iwp))
+        dr = gwlon(iwp+1) - gxw
+        dl = gxw - gwlon(iwp)
+        yyy = ( dyw - yj1 ) / dyj + 0.5
+        jwp = nint(yyy) 
+        jwp = max(1,min(jmax,jwp))
+        du = gwlat(jwp+1) - dyw
+        dd = dyw - gwlat(jwp)
+      else
+        !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+        yw   = ttlat(j)
+        dyw  = yw*radian
+        dsyw = sin(dyw)
+        dcyw = cos(dyw)
+        xw   = mod(ttlon(i)-beta, untour)
+        dxw  = xw*radian
+        dsxw = sin(dxw)
+        dcxw = cos(dxw)
+        !--COMPUTE COORDINATES ON THE SS GRID OF A POINT OF THE AA GRID.
+        dya = asin(dcyw*dcxw) * degre
+        dxa = atan2(dcyw*dsxw,-dsyw) * degre
+        dxa = mod(dxa+untour, untour)
+        !---
+        yyy = ( dxa - xaj1 ) / dxaj + 0.5
+        jwp = nint(yyy) 
+        jwp = max(0,min(jmax,jwp))
+        du = galon(jwp+1) - dxa
+        dd = dxa - galon(jwp)
+        xxx = ( dya - yai1 ) / dyai + 0.5
+        iwp = nint(xxx) 
+        iwp = max(0,min(imax-1,iwp))
+        dr = galat(iwp+1) - dya
+        dl = dya - galat(iwp)
+
+      endif
+      !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+
+      !--Pour verification :
+      !        goto 550
+      nn0=999999.99
+      nn1=999999.99
+      if (ttlon(i).ge.369. .or. ttlon(i).le.-1. ) then
+        nprt = nprt + 1
+        if (nprt.ge.nn0 .and.  nprt.le.nn1 ) then
+          write(99,*) 'nprt, whigri(i,j) :', nprt, whigri(i,j)
+          write(99,*) 'i,j, iwp, jwp :'
+          write(99,*)  i,j, iwp, jwp
+          write(99,*) 'dl, dr, dd, du :'
+          write(99,*)  dl, dr, dd, du
+          if ( whigri(i,j).eq.1.0d0) then
+            write(99,*) 'dxw, dyw :'
+            write(99,*)  dxw, dyw
+          else
+            write(99,*) 'dxa, dya :'
+            write(99,*)  dxa, dya 
+          endif
+          !            write(99,*) ' ttlon, ttlat :', ttlon(i), ttlat(j)
+          !            write(99,*) ' gwlon, gwlat :', gwlon(iwp), gwlat(jwp)
+          !            write(99,*) ' galon, galat :', galon(jwp), galat(iwp)
+        endif
+      endif
+
+      !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+      !   5 ) Interpolation a partir des 4 voisins iwp/iwp+1,jwp/jwp+1 .     |
+      !-----------------------------------------------------------------------
+
+      !--POINT (i,j). A POINT IS CONSIDERED TO BE A LAND POINT 
+      !--IF THE NEAREST DATA POINT IS A LAND POINT.
+
+      unsdtx = 1.0 / (dl + dr)
+      rl = dl * unsdtx
+      rr = dr * unsdtx
+      unsdty = 1.0 / (dd + du)
+      rd = dd * unsdty
+      ru = du * unsdty
+
+      !--debut du traitement du point (i,j) :
+      valcl = wdata3D(iwp,jwp,1)
+      valcr = wdata3D(iwp+1,jwp,1)
+      !if (valcl.eq.spv) then
+      if ((valcl.gt.spvMin).and.(valcl.lt.spvMax).or.(valcl.eq.0.0)) then
+        if (rl.le.0.5) then
+          valad = valcl
+        else
+          valad = valcr
+          valcd = valcr
+        endif
+      else
+        if ((valcr.gt.spvMin).and.(valcr.lt.spvMax).or.(valcr.eq.0.0)) then
+          !if (valcr.eq.spv) then
+          if (rr.le.0.5) then
+            valad = valcr
+          else
+            valad = valcl
+            valcd = valcl
+          endif
+        else
+          valad = valcl * rr + valcr * rl
+          valcd = valad
+        endif
+      endif
+
+      valcl = wdata3D(iwp,jwp+1,1)
+      valcr = wdata3D(iwp+1,jwp+1,1)
+      !if (valcl.eq.spv) then
+      if ((valcl.gt.spvMin).and.(valcl.lt.spvMax).or.(valcl.eq.0.0)) then
+        if (rl.le.0.5) then
+          valau = valcl
+        else
+          valau = valcr
+          valcu = valcr
+        endif
+      else
+        if ((valcr.gt.spvMin).and.(valcr.lt.spvMax).or.(valcr.eq.0.0)) then
+          !if (valcr.eq.spv) then
+          if (rr.le.0.5) then
+            valau = valcr
+          else
+            valau = valcl
+            valcu = valcl
+          endif
+        else
+          valau = valcl * rr + valcr * rl
+          valcu = valau
+        endif
+      endif
+
+      if ((valad.gt.spvMin).and.(valad.lt.spvMax).or.(valad.eq.0.0)) then
+        !if (valad.eq.spv) then
+        if (rd.le.0.5) then
+          wdatai3D(i,j,1)  = spv
+        else
+          if ((valau.gt.spvMin).and.(valau.lt.spvMax).or.(valau.eq.0.0)) then
+            !if (valau.eq.spv) then
+            wdatai3D(i,j,1) = spv
+          else
+            valc        = valcu
+            wdatai3D(i,j,1) = valcu
+          endif
+        endif
+      else
+        if ((valau.gt.spvMin).and.(valau.lt.spvMax).or.(valau.eq.0.0)) then
+          !if (valau.eq.spv) then
+          if (ru.le.0.5) then
+            wdatai3D(i,j,1) = spv
+          else
+            valc        = valcd
+            wdatai3D(i,j,1) = valcd
+          endif
+        else
+          valc        = valcd * ru + valcu * rd
+          wdatai3D(i,j,1) = valc
+        endif
+      endif
+
+
+      !--Pour verification : 
+      nn0=999999.99
+      nn1=999999.99
+      if (ttlon(i).ge.369. .or. ttlon(i).le.-1. ) then
+        if (nprt.ge.nn0 .and.  nprt.le.nn1 ) then
+          write(99,*) 'val(i,i+1,/j,j+1) ='
+          write(99,'(4F10.4)') val(iwp,jwp), val(iwp+1,jwp), val(iwp,jwp+1), val(iwp+1,jwp+1)
+          !            write(99,*) 'vala(i,j,1) =', vala(i,j,1)
+          write(99,*) 'wdatai3D(i,j,1) =', wdatai3D(i,j,1)
+        endif
+      endif
+
+    enddo
+  enddo
+
+  return
+
+end
+
+subroutine gridtt(ttlon,ttlat,imtt,jmtt)
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+  !
+  !--DEFINE INTERPOLATING GRID TT.
+  !--LATITUDES AND LONGITUDES CORRESPOND TO THE CENTERS OF THE GRID ELEMENTS.
+  !
+  implicit double precision (a-h,o-z)
+  !
+  integer :: imtt, jmtt,i, j
+  real*4 :: xlong1, delx, dely
+  real*4 :: ttlon(imtt),ttlat(jmtt)
+  !     xlong1 = 23
+  xlong1 = 0.0
+  delx=360.0/real(imtt)
+  dely=180.0/real(jmtt)
+  do i=1,imtt
+    !       ttlon(i)=xlong1+real(i-1)*delx+0.5*delx
+    ttlon(i)=xlong1+real(i-1)*delx
+    ttlon(i)=mod(ttlon(i),360.0d0)
+  enddo
+  do j=1,jmtt
+    ttlat(j)=-90.+real(j-1)*dely+0.5*dely
+  enddo
+  return
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+end
+
+subroutine choiceg(ttlat,ttlong,imtt,jmtt,whigri)
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+  !
+  !               THIS ROUTINE DETERMINE AT WHICH ORIGINAL GRID (AA OR WW)
+  !               EACH POINT OF TT CORRESPOND.
+  !
+  implicit double precision (a-h,o-z)
+  !
+  integer :: imtt, jmtt, i,j
+  real*4 :: whigri(imtt,jmtt)
+  real*4 :: ttlat(jmtt),ttlong(imtt)
+  real*4 :: xoncri
+  !     
+  !     write(6,*) 'begining of choiceg'
+  do i=1,imtt
+    do j=1,jmtt
+      whigri(i,j)=1.
+    enddo
+  enddo
+  !
+  !     write(6,*) 'after 10'
+  do i=1,imtt
+    do j=1,jmtt
+      if (ttlat(j).gt.0.0.and.ttlat(j).le.8.0) then
+        if ((ttlong(i).ge.290.).or.(ttlong(i).lt.30.)) then
+          whigri(i,j)=2.
+          !             write(10,*) ttlat(j),ttlong(i)
+        endif
+      endif
+      if ((ttlat(j).gt.8.).and.(ttlat(j).le.10.)) then
+        xoncri=281.+(ttlat(j)-8.)/(10.-8.)*(276.-281.)
+        if (ttlong(i).ge.xoncri.or.ttlong(i).lt.30.) whigri(i,j)=2.
+      endif
+      if ((ttlat(j).gt.10.).and.(ttlat(j).le.15.)) then
+        xoncri=276.+(ttlat(j)-10.)/(15.-10.)*(270.-276.)
+        if (ttlong(i).ge.xoncri.or.ttlong(i).lt.30.) whigri(i,j)=2.
+      endif
+      if ((ttlat(j).gt.15.).and.(ttlat(j).le.20.)) then
+        xoncri=270.+(ttlat(j)-15.)/(20.-15.)*(260.-270.)
+        if (ttlong(i).ge.xoncri.or.ttlong(i).lt.30) whigri(i,j)=2.
+      endif
+      if ((ttlat(j).gt.20.).and.(ttlat(j).le.30.)) then
+        xoncri=260.+(ttlat(j)-20.)/(30.-20.)*(260.-260.)
+        if (ttlong(i).ge.xoncri.or.ttlong(i).lt.30.) whigri(i,j)=2.
+      endif
+      if ((ttlat(j).gt.30.).and.(ttlat(j).le.68.)) then
+        xoncri=260.+(ttlat(j)-30.)/(65.-30.)*(260.-260.)
+        if (ttlong(i).ge.xoncri.or.ttlong(i).lt.50.) whigri(i,j)=2.
+      endif
+      if ((ttlat(j).gt.67.).and.(ttlat(j).le.90.)) then
+        xoncri=0
+        if (ttlong(i).ge.xoncri.or.ttlong(i).lt.360.) whigri(i,j)=2.
+      endif
+      !
+    enddo
+  enddo
+  !
+  !     write(6,*) 'end of choiceg'
+  return
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+end
+  !
+subroutine mercatv(ttlon,ttlat,wdatx,wdaty,valgu,valgv)
+  !
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+  !--INTERPOLATION OF SCALAR DATA PLACED AT THE CENTER OF THE
+  !--ELEMENTS OF A TWO RECTANGULAR GRID ONTO ONE GRID.
+  !--LONGITUDE-LATITUDE COORDINATES FOR BOTH GRIDS.
+  !--DATA ARE OUTPUTS OF THE PROGRAM OTI.
+  !
+  !--M.A.Morales Maqueda, 11-IV-1994.
+  !--modified by H.GOOSSE 15-IV-1994
+  !--modified by H.GOOSSE + M.A.M. Maqueda 15-IV-1994
+  !--modified by H.GOOSSE 16-V-1994
+  !--modified by JMC 19/09/95, adapted for vector, (derived from "provect").
+  !  modif : 21/09/95
+
+  !--(alpha,beta): (latitude,longitude) of the north pole of the new grid.
+  !
+  USE bloc_commun
+
+  integer, parameter :: nsmax = 2
+
+  real*4 :: ttlon(imtt)
+  real*4 :: ttlat(jmtt)
+
+  real*4 :: galat(0:imax), gwlon(0:imax)
+  real*4 :: gwlat(0:imax), galon(0:jmax+1)
+  real*4 :: cxw(0:imax), sxw(0:imax), cyw(0:jmax+1), syw(0:jmax+1)
+  real*4 :: cya(0:imax), sya(0:imax), cxa(0:jmax+1), sxa(0:jmax+1)
+
+  real*4 :: wdatx(imax,jmax), wdaty(imax,jmax)
+  real*4 :: valx(0:imax,0:jmax+1), valy(0:imax,0:jmax+1), valz(0:imax,0:jmax+1)
+
+  real*4 :: valgu(imtt,jmtt), valgv(imtt,jmtt)
+  real*4 :: cxt(imtt), sxt(imtt)
+  real*4 :: cyt(jmtt), syt(jmtt)
+  real*4 :: whigri(imtt,jmtt)
+
+  integer :: im, jm, i, j, gxw, iwp, jwp, nprt, nncrv
+  real*4 ::  xaj1, yai1, dxaj, dyai, dxw, dyw, xxx, yyy, du, dd, dr, dl, unsdtx, unsdty, valdw, valxd, valzd, valup, valxu, valyu, valyd, valzu
+  real*4 :: dxa, dya, nn0, nn1, rd, ru, rr, rl, ylim, ylim1, ylim2, valg, vvx, vvy, vvz
+
+
+
+
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+
+  1001 format(A32,1x,E13.6,1x,I6,1x,I6,1x,I6,1x,I6)
+  1000 format(A30,1x,E13.6,1x,I6,1x,I6,1x,I6,1x,I6)
+  1111 format(3(F7.2,1X,F7.3,1X),I3,A)
+
+  !--READ DATA.
+  im=imax
+  jm=jmax
+
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+
+  !--Initialisation :
+  do j=0,jmax+1
+    do i=0,imax
+      !        valu(i,j) = spv
+      !        valv(i,j) = spv
+      valx(i,j) = 0.
+      valy(i,j) = 0.
+      valz(i,j) = 0.
+    enddo
+  enddo
+
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+  !  3 ) definition de la nouvelle grille .                              |
+  !-----------------------------------------------------------------------
+
+  !-----
+  !--DEFINE INTERPOLATING GRID WW.
+  !
+  call gridtt(ttlon,ttlat,imtt,jmtt)
+  do i=1,imtt
+    cxt(i) = cos(radian*(ttlon(i)-beta))
+    sxt(i) = sin(radian*(ttlon(i)-beta))
+  enddo
+  do j=1,jmtt
+    cyt(j) = cos(radian*ttlat(j))
+    syt(j) = sin(radian*ttlat(j))
+  enddo
+
+  !--DEFINE ORIGINAL GRIDS.
+  !----
+  !     xi1=xlon1
+  !     dxi=dlong
+  !     yj1=ylat1
+  !     dyj=dlat
+
+  xaj1 =  90. + yj1
+  yai1 =  90. + beta + untour - xi1
+  dxaj = dyj
+  dyai = -dxi
+  do i=0,imax
+    gwlon(i) = xi1 + dxi * DFLOAT(i-1)
+    galat(i) = 90. + beta + untour - gwlon(i)
+    cxw(i) = cos(radian*(gwlon(i)-beta))
+    sxw(i) = sin(radian*(gwlon(i)-beta))
+    cya(i) = cos(radian*galat(i))
+    sya(i) = sin(radian*galat(i))
+  enddo
+  do j=0,jmax+1
+    gwlat(j) = yj1 + dyj * DFLOAT(j-1)
+    galon(j) = 90. + gwlat(j)
+    cyw(j) = cos(radian*gwlat(j))
+    syw(j) = sin(radian*gwlat(j))
+    cxa(j) = cos(radian*galon(j))
+    sxa(j) = sin(radian*galon(j))
+  enddo
+
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+
+  !--COOMPUTE DE CORRESPONDANCE BETWEEN GRIDS
+
+  call choiceg(ttlat,ttlon,imtt,jmtt,whigri)
+
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+  !--calcul des 3 composantes dans le repere fixe .
+
+  ylim1 = 69.0
+  ylim2 = 294.0
+  !- critere d'apartenace a Grille AA : y > min[ 69., max(0., 294. - x) ]
+  do j=1,jm
+    do i=1,im
+      ylim = min(ylim1, max(zero, ylim2-gwlon(i)) )
+      if (gwlat(j).le.ylim) then
+        !- WW :
+        valx(i,j) = -sxw(i)*wdatx(i,j)-syw(j)*cxw(i)*wdaty(i,j)
+        valy(i,j) =  cxw(i)*wdatx(i,j)-syw(j)*sxw(i)*wdaty(i,j)
+        valz(i,j) =  cyw(j)*wdaty(i,j)
+
+      else
+        !- AA :
+        valz(i,j) =  sxa(j)*wdaty(i,j)-sya(i)*cxa(j)*wdatx(i,j)
+        valy(i,j) =  cxa(j)*wdaty(i,j)+sya(i)*sxa(j)*wdatx(i,j)
+        valx(i,j) = -cya(i)*wdatx(i,j)
+      endif
+    enddo
+  enddo
+
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+  !  4 ) Traitement de la nouvelle grille colonne par colonne .          |
+  !-----------------------------------------------------------------------
+
+  !--MAIN DO-LOOP.
+
+  do j=1,jmtt
+    do i=1,imtt
+      !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+      !--debut du traitement de la colonne (i,j) :
+      if (whigri(i,j).eq.1.) then
+        dxw = ttlon(i)
+        dyw = ttlat(j)
+        gxw = xi1 + mod(dxw-xi1+untour, untour)
+        xxx = ( gxw - xi1 ) / dxi + 0.5
+        iwp = nint(xxx)
+        iwp = max(0,min(imax-1,iwp))
+        dr = gwlon(iwp+1) - gxw
+        dl = gxw - gwlon(iwp)
+        yyy = ( dyw - yj1 ) / dyj + 0.5
+        jwp = nint(yyy)
+        jwp = max(0,min(jmax,jwp))
+        du = gwlat(jwp+1) - dyw
+        dd = dyw - gwlat(jwp)
+      else
+        !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+        !--COMPUTE COORDINATES ON THE SS GRID OF A POINT OF THE AA GRID.
+        dya = asin(cyt(j)*cxt(i)) * degre
+        dxa = atan2(cyt(j)*sxt(i),-syt(j)) * degre
+        dxa = mod(dxa+untour, untour)
+        !---
+        yyy = ( dxa - xaj1 ) / dxaj + 0.5
+        jwp = nint(yyy)
+        jwp = max(0,min(jmax,jwp))
+        du = galon(jwp+1) - dxa
+        dd = dxa - galon(jwp)
+        xxx = ( dya - yai1 ) / dyai + 0.5
+        iwp = nint(xxx)
+        iwp = max(0,min(imax-1,iwp))
+        dr = galat(iwp+1) - dya
+        dl = dya - galat(iwp)
+
+      endif
+      !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+
+      !--Pour verification :
+      !        goto 550
+      nn0=999999.99
+      nn1=999999.99
+      if (ttlon(i).ge.369. .or. ttlon(i).le.-1. ) then
+        nprt = nprt + 1
+        if (nprt.ge.nn0 .and.  nprt.le.nn1 ) then
+          write(99,*) 'nprt, whigri(i,j) :', nprt, whigri(i,j)
+          write(99,*) 'i,j, iwp, jwp :'
+          write(99,*)  i,j, iwp, jwp
+          write(99,*) 'dl, dr, dd, du :'
+          write(99,*)  dl, dr, dd, du
+          if ( whigri(i,j).eq.1.0d0) then
+            write(99,*) 'dxw, dyw :'
+            write(99,*)  dxw, dyw
+          else
+            write(99,*) 'dxa, dya :'
+            write(99,*)  dxa, dya
+          endif
+          !            write(99,*) ' ttlon, ttlat :', ttlon(i), ttlat(j)
+          !            write(99,*) ' gwlon, gwlat :', gwlon(iwp), gwlat(jwp)
+          !            write(99,*) ' galon, galat :', galon(jwp), galat(iwp)
+        endif
+      endif
+
+      !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+      !   5 ) Interpolation a partir des 4 voisins iwp/iwp+1,jwp/jwp+1 .     |
+      !-----------------------------------------------------------------------
+
+      !--POINT (i,j). A POINT IS CONSIDERED TO BE A LAND POINT
+      !--IF THE NEAREST DATA POINT IS A LAND POINT.
+
+      unsdtx = 1.0 / (dl + dr)
+      rl = dl * unsdtx
+      rr = dr * unsdtx
+      unsdty = 1.0 / (dd + du)
+      rd = dd * unsdty
+      ru = du * unsdty
+
+      !--debut du traitement du point (i,j,k) :
+
+      if ((wdatx(iwp,jwp).gt.spvMin).and.(wdatx(iwp,jwp).lt.spvMax).or.(wdatx(iwp,jwp).eq.0.0)) then
+        !if (wdatx(iwp,jwp).eq.spv) then
+        if (rl.le.separ) then
+          valdw = spv
+        else
+          valdw = wdatx(iwp+1,jwp)
+          valxd = valx(iwp+1,jwp)
+          valyd = valy(iwp+1,jwp)
+          valzd = valz(iwp+1,jwp)
+        endif
+      else
+        if ((wdatx(iwp+1,jwp).gt.spvMin).and.(wdatx(iwp+1,jwp).lt.spvMax).or.(wdatx(iwp+1,jwp).eq.0.0)) then
+          !if (wdatx(iwp+1,jwp).eq.spv) then
+          if (rr.le.separ) then
+            valdw = spv
+          else
+            valdw = wdatx(iwp,jwp)
+            valxd = valx(iwp,jwp)
+            valyd = valy(iwp,jwp)
+            valzd = valz(iwp,jwp)
+          endif
+        else
+          valdw = rr*wdatx(iwp,jwp)+rl*wdatx(iwp+1,jwp)
+          valxd = rr*valx(iwp,jwp) + rl*valx(iwp+1,jwp)
+          valyd = rr*valy(iwp,jwp) + rl*valy(iwp+1,jwp)
+          valzd = rr*valz(iwp,jwp) + rl*valz(iwp+1,jwp)
+        endif
+      endif
+      !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+      !
+      if ((wdatx(iwp,jwp+1).gt.spvMin).and.(wdatx(iwp,jwp+1).lt.spvMax).or.(wdatx(iwp,jwp+1).eq.0.0)) then
+        !if (wdatx(iwp,jwp+1).eq.spv) then
+        if (rl.le.separ) then
+          valup = spv
+        else
+          valup = wdatx(iwp+1,jwp+1)
+          valxu = valx(iwp+1,jwp+1)
+          valyu = valy(iwp+1,jwp+1)
+          valzu = valz(iwp+1,jwp+1)
+        endif
+      else
+        if ((wdatx(iwp+1,jwp+1).gt.spvMin).and.(wdatx(iwp+1,jwp+1).lt.spvMax).or.(wdatx(iwp+1,jwp+1).eq.0.0)) then
+          !if (wdatx(iwp+1,jwp+1).eq.spv) then
+          if (rr.le.separ) then
+            valup = spv
+          else
+            valup = wdatx(iwp,jwp+1)
+            valxu = valx(iwp,jwp+1)
+            valyu = valy(iwp,jwp+1)
+            valzu = valz(iwp,jwp+1)
+          endif
+        else
+          valup = rr*wdatx(iwp,jwp+1)+rl*wdatx(iwp+1,jwp+1)
+          valxu = rr*valx(iwp,jwp+1) + rl*valx(iwp+1,jwp+1)
+          valyu = rr*valy(iwp,jwp+1) + rl*valy(iwp+1,jwp+1)
+          valzu = rr*valz(iwp,jwp+1) + rl*valz(iwp+1,jwp+1)
+        endif
+      endif
+      !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+      !
+      if ((valdw.gt.spvMin).and.(valdw.lt.spvMax).or.(valdw.eq.0.0)) then
+        !if (valdw.eq.spv) then
+        if (rd.le.separ) then
+          valg  = spv
+          valgu(i,j)  = spv
+          valgv(i,j)  = spv
+        else
+          if ((valup.gt.spvMin).and.(valup.lt.spvMax).or.(valup.eq.0.0)) then
+            !if (valup.eq.spv) then
+            valg  = spv
+            valgu(i,j)  = spv
+            valgv(i,j)  = spv
+          else
+            valg = valup
+            valgu(i,j) = -sxt(i)*valxu + cxt(i)*valyu
+            valgv(i,j) =  cyt(j)*valzu - syt(j) * ( cxt(i)*valxu + sxt(i)*valyu )
+            !               valgv(i,j,k) =  valzu / cyt(j)
+          endif
+        endif
+      else
+        !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+        if ((valup.gt.spvMin).and.(valup.lt.spvMax).or.(valup.eq.0.0)) then
+          !if (valup.eq.spv) then
+          if (ru.le.separ) then
+            valg  = spv
+            valgu(i,j)  = spv
+            valgv(i,j)  = spv
+          else
+            valg = valdw
+            valgu(i,j) = -sxt(i)*valxd + cxt(i)*valyd
+            valgv(i,j) =  cyt(j)*valzd - syt(j) * ( cxt(i)*valxd + sxt(i)*valyd )
+            !               valgv(i,j,k) =  valzd / cyt(j)
+          endif
+        else
+          valg  = rd*valup + ru*valdw
+          vvx = rd*valxu + ru*valxd
+          vvy = rd*valyu + ru*valyd
+          vvz = rd*valzu + ru*valzd
+          valgu(i,j) = -sxt(i)*vvx + cxt(i)*vvy
+          valgv(i,j) =  cyt(j)*vvz - syt(j) * ( cxt(i)*vvx + sxt(i)*vvy )
+          !               valgv(i,j,k) =  vvz / cyt(j)
+        endif
+      endif
+      !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+      nncrv=1
+      if (nncrv.eq.0) valgu(i,j) = valg
+
+      !         if (whigri(i,j).eq.2) write(6,*) valgu(i,j,k)
+      !--Pour verification :
+      if (ttlon(i).ge.369. .or. ttlon(i).le.-1. ) then
+        if (nprt.ge.nn0 .and.  nprt.le.nn1 ) then
+          !            write(99,*) 'valu(i,i+1,/j,j+1) ='
+          !            write(99,'(4F10.4)') valu(iwp,jwp,1), valu(iwp+1,jwp,1),
+          !    &                          valu(iwp,jwp+1,1), valu(iwp+1,jwp+1,1)
+          write(99,*) 'valgu(i,j) =', valgu(i,j)
+        endif
+      endif
+
+      !--fin du traitement de la colonne (i,j) .
+    enddo
+  enddo
+  !
+  return
+
+  !---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+end

src/08_compile_netcdf.txt

@@ -0,0 +1,3 @@
+ifort -o OceanGrideChange.exe 8_OceanGrideChange.f90 -I${EBROOTNETCDFMINFORTRAN}/include -L${EBROOTNETCDFMINFORTRAN}/lib -lnetcdff
+
+gfortran -ffree-line-length-none -o OceanGrideChange.exe 8_OceanGrideChange.f90 -I${EBROOTNETCDFMINFORTRAN}/include -L${EBROOTNETCDFMINFORTRAN}/lib -lnetcdff

src/09_ChristmasTree.txt

@@ -0,0 +1,63 @@
+CHRISTMAS TREE
+--------------
+
+The aim of this exercise is to work with loops (for or while) in order to draw in a terminal a Christmas tree with its balls:
+
+Height=10
+
+         #
+        ###
+       #o###
+      ##o####
+     #o#####o#
+    ####o#####o
+   #####o#####o#
+  ####o#####o####
+ #o#####o#####o###
+##o#####o#####o####
+
+The program must be carried out in Fortran 90. It will take as argument the height of the tree which is a variable of the problem:
+
+Height=7
+
+      #
+     ###
+    #o###
+   ##o####
+  #o#####o#
+ ####o#####o
+#####o#####o#
+
+This parameter must be supplied at the command line when the program (for example './tree 10'). 
+
+Balls must be positioned all 6 sharps as shown below:
+
+Height=7
+
+      1
+     234
+    5!123
+   45!1234
+  5!12345!1
+ 2345!12345!
+12345!12345!1
+
+
+Usefull commands:
+-----------------
+
+Read a parameter in the program argument:
+call getarg (1, param)
+where param is a string of sufficient length to contain the value supplied as argument
+
+Convert a character string to integer or float:
+read (mychar, *) myinteger
+
+Write a character on the screen:
+write (*, '(A)') "#"
+
+Write a character on the screen without going back to the line:
+write (*, '(A)', advance = 'no') "#"
+
+Make a modulo:
+myModulo = mod (10,3)

src/10_eqdiff.txt

@@ -0,0 +1,12 @@
+Résolvez numériquement l’équation suivante pour une condition initiale u(t=0)=0 et un pas de temps delta_t = pi/50
+du/dt = A cos(t)
+
+PS: prenons A=1
+
+Que se passe-t-il si le cosinus est évalué en 
+n*delta_t
+(n+0.5)*delta_t
+(n+1)*delta_t
+
+Approximation:
+(U(n+1) - U(n)) / delta_t = A cos(n*delta_t)

src/11_OLD.FOR

@@ -0,0 +1,711 @@
+C
+C******************************************************************************
+C
+C      VERSION FEVRIER 1986                                             TEQ00070
+C                                                                       TEQ00080
+C  LINKEE POUR LE VAX 3800 LE 10/10/89
+C
+      INTEGER TITRE(74),ESP(8),PIED(9),KART(80)                         TEQ00110
+      INTEGER DICO(215)                                                 TEQ00120
+      INTEGER JDIN(14),JNUAN(2)                                         TEQ00130
+      INTEGER TEQ0,TEQ1,TEQ2,TEQ3,TEQ4,TEQ5,TEQ6,TEQ7,TEQ8,TEQ9         TEQ00140
+      INTEGER TEQA,TEQB,TEQC,TEQD,TEQE,TEQF,TEQG,TEQH,TEQI,TEQJ,TEQK    TEQ00150
+      INTEGER TEQW,TEQZ,TEQL,TEQM                                       TEQ00160
+      INTEGER ITOUT(11)                                                 TEQ00170
+      INTEGER ILABEL(10)                                                TEQ00180
+C                                                                       TEQ00190
+C                                                                       TEQ00240
+      DIMENSION IBUF(1804),Z(500),LABEL(4,200)                          TEQ00250
+      DIMENSION LLOAD(32)                                               TEQ00260
+      COMMON /POTBIA/ WWWW(1500)                                        TEQ00280
+      COMMON /TITRES/ITITR(21,50)                                       TEQ00290
+      COMMON /UNIT/IUNIT(20)                                            TEQ00300
+      COMMON /RECORD/PLA33(173)                                         TEQ00310
+      COMMON /ESPION/ IESP,LLNOM,ILIST,INORD,NCREP                      TEQ00320
+      COMMON /DESSIN/ IBUF                                              TEQ00330
+      COMMON /OPTCD/ IFEET,ITEST,INUAN(2),IRAIDS                        TEQ00340
+      COMMON /MARQ/ PLA21(6000)                                         TEQ00350
+      COMMON /BUFFER/ PLA13(2400)                                       TEQ00360
+      COMMON /TECK/IC14,IC13,IECHW,INOM,IATA,IBART,IQUAL                TEQ00370
+      COMMON /PLACE/ KART,PLA1(9)                                       TEQ00380
+      COMMON E,N,X(500),Y(500),IX(4,500),PLA(6000)                      TEQ00390
+      COMMON /WORK/ IY(4,500),JBJ(2400)                                 TEQ00400
+      COMMON /CANAD/ KX(500),KY(500),PLA20(624) ,ICANAD(200)            TEQ00410
+C      DORBYL 6000---->300000                                           TEQ00420
+      COMMON /PER/ NPER,PLA2(6000)                                      TEQ00430
+      COMMON /IPERM/ NPERM,PLA3(1000)                                   TEQ00440
+      COMMON /DIVER/ ISUP,ILANG,IW28,PLA4(6),IDIN,KLAS(4),JPROJ         TEQ00450
+      COMMON /SORTI/ PLA6(80)                                           TEQ00460
+      COMMON /ENTREE/IPLA7(42)                                          TEQ00470
+      COMMON /SOMEL/ PLA8(2)                                            TEQ00480
+      COMMON /SUITW/ PLA10(8),MARG                                      TEQ00490
+      COMMON /GOUSD/ PLA11(6)                                           TEQ00500
+      COMMON /CARTO/ ICAS,XCAR(3,8),TITRE                               TEQ00510
+      COMMON /DORBYL/NSTUD,ISTUD(2000)                                  TEQ00520
+      COMMON /DOUBL/NDUP,IRED1(2,80),IRED2(2,80),NDUPL(80),IOPD(80)     TEQ00530
+      COMMON /RAIDIS/NBRD(400)                                          TEQ00540
+      COMMON /REJCOM/LABEL,NLABEL                                       TEQ00550
+C                                                                       TEQ00560
+C                                                                       TEQ00570
+      EQUIVALENCE (PLA13(1101),Z(1))                                    TEQ00580
+      EQUIVALENCE (IUNIT(1),INPUT)                                      TEQ00590
+      EQUIVALENCE (IUNIT(3),IUNI3)                                      TEQ00600
+      EQUIVALENCE (IUNIT(6),IUNI6)                                      TEQ00610
+      EQUIVALENCE (IUNIT(7),IUNI7)                                      TEQ00620
+      EQUIVALENCE (IUNIT(13),IUNI13)                                    TEQ00630
+      EQUIVALENCE (IUNIT(17),IUNI17)                                    TEQ00640
+C                                                                       TEQ00650
+C                                                                       TEQ00730
+C==========================================================I            TEQ00740
+C  OVERLAY          6                 7             8      I            TEQ00750
+C==========================================================I            TEQ00760
+C  BARRES       TEQ1 DIMEN     TEQ3 BARRE     TEQ4 IMETA   I            TEQ00770
+C               TEQ5 TABAR                                 I            TEQ00780
+C==========================================================I            TEQ00790
+C  NOEUDS       TEQ1 DIMEN     TEQ2 TOPOL                  I            TEQ00800
+C                                   TOFF                   I            TEQ00810
+C==========================================================I            TEQ00820
+C  FLECHE       TEQ1 DIMEN                    TEQZ KFLCH   I            TEQ00830
+C==========================================================I            TEQ00840
+C  BOULON/STUDS TEQW BOUDEZ                                I            TEQ00850
+C               DUPLN STUDS                                I            TEQ00860
+C==========================================================I            TEQ00870
+C  MONTAGE      TEQ1 DIMEN     TEQ9 MONTA                  I            TEQ00880
+C  EPURE        TEQ1 DIMEN     TEQ8 EPURE                  I            TEQ00890
+C==========================================================I            TEQ00900
+C  ARCHI        TEQI ARCHI                                 I            TEQ00910
+C==========================================================I            TEQ00920
+C  DIVERS                                  TEQ0 AMETA      I            TEQ00930
+C                                          TREMY COTAT..   I            TEQ00940
+C==========================================================I            TEQ00950
+C  DETAIL        TEQ6 NABLA    TEQJ PROCU   TEQ7 PROCT     I            TEQ00960
+C==========================================================I            TEQ00970
+C  NOMENCLATURE  TEQ6 REWRX    TEQK CBOUL   TEQH MAYEN     I            TEQ00980
+C                     TEQTI    TBOUL BULET  TEQE MAYAN     I            TEQ00990
+C                                           TEQG BULON     I            TEQ01000
+C==========================================================I            TEQ01010
+C  GRUGE         TEQB GRUG4    TEQF TROUA   TEQM GRUG3/SED.I            TEQ01020
+C  FICHE         TEQC GRUGA    TEQD GRUF/2  TEQL DUPLI/GU  I            TEQ01030
+C==========================================================I            TEQ01040
+C                                                                       TEQ01050
+      DATA TEQ0/'TEQ0'/,TEQ1/'TEQ1'/,TEQ2/'TEQ2'/,TEQ3/'TEQ3'/          TEQ01060
+      DATA TEQ4/'TEQ4'/,TEQ5/'TEQ5'/,TEQ6/'TEQ6'/,TEQ7/'TEQ7'/          TEQ01070
+      DATA TEQ8/'TEQ8'/,TEQ9/'TEQ9'/,TEQA/'TEQA'/,TEQB/'TEQB'/          TEQ01080
+      DATA TEQC/'TEQC'/,TEQD/'TEQD'/,TEQE/'TEQE'/,TEQF/'TEQF'/          TEQ01090
+      DATA TEQG/'TEQG'/,TEQH/'TEQH'/,TEQI/'TEQI'/,TEQJ/'TEQJ'/          TEQ01100
+      DATA TEQK/'TEQK'/,TEQW/'TEQW'/,TEQZ/'TEQZ'/,TEQL/'TEQL'/          TEQ01110
+      DATA TEQM/'TEQM'/                                                 TEQ01120
+C                                                                       TEQ01130
+C    0 RIEN          1 NOEUDS/POTEAU    2 BARRE/EPURE/MONTAGE           TEQ01140
+C    3 DIVERS        4 ARCHI            5 DETAIL                        TEQ01150
+C    6 BOULON/GOUJON/OFF                                                TEQ01160
+C                                                                       TEQ01170
+      DATA LLOAD/1,1,2,8*3,0,0,3,4,2*2,3,5,3,0,3,1,6,6,0,7,4*0,6/       TEQ01180
+      DATA ESP/6,'E','S','P','I','O','N',0/                             TEQ01190
+      DATA PIED/4,'P','I','E','D',2,'C','M',0/                          TEQ01200
+      DATA JDIN/8,'D','I','N',' ','7','9','9','0',3,'E','D','F',0/      TEQ01210
+      DATA DICO/5,'N','O','E','U','D',4,'P','O','T','E',3,'B','A','R',4 TEQ01220
+     *,'T','R','E','M',3,'P','E','R', 3,'C','O','M',3,'C','O','T',3,'R',TEQ01230
+     *'E','P',4,'N','O','T','A',3,'A','X','E',4,'T','R','O','U',3,'F','ITEQ01240
+     *','N',5,'N','O','M','E','N',5,'C','O','N','T','O',5,'A','R','C','HTEQ01250
+     *','I',5,'E','P','U','R','E',5,'M','O','N','T','A',4,'A','J','O','UTEQ01260
+     *',6,'D','E','T','A','I','L',3,'A','R','C',4,'C','L','O','U',      TEQ01270
+     *4,'C','A','R','T',6,'F','L','E','C','H','E',8,'*','*','B','O','U',TEQ01280
+     *'L','O','N',4,'G','O','U','J',4,'T','E','S','T',5,'*','*','O','F',TEQ01290
+     &'F',4,'D','A','T','A',4,'N','O','R','D',                          TEQ01300
+     *9,'E','N','T','R','E',' ','A','X','E',6,'N','U','A','N','C','E',  TEQ01310
+     *11,'D','U','P','L','I','C','A','T','I','O','N',                   TEQ01320
+     *6,'C','L','A','S','S','E',7,'P','R','O','J','E','C','T',          TEQ01330
+     *5,'M','A','R','G','E',5,'S','T','A','R','T',5,'R','E','J','E','T',TEQ01340
+     *0/                                                                TEQ01350
+      DATA ITOUT /4,'T','O','U','T','OU',3,'A','L','L',0/               TEQ01360
+      DATA IBL/'    '/                                                  TEQ01370
+      DATA JNUAN/'E242','    '/                                         TEQ01380
+      DATA ILABEL/'DRAW','N BY',' TEQ','UILA',' SYS','TEM ','ALBI',     TEQ01390
+     *' 63.','42.0','7.55'/                                             TEQ01400
+C
+C      VAX                                                              TEQ01560
+C                                                                       TEQ01570
+      OPEN(FILE='AKJ7.KIR',UNIT=1,STATUS='OLD')
+C      DEFINE FILE 10(810,200,U,IC10)                                    TEQ01580
+      OPEN (FILE='CODEBAR.DAT',UNIT=10,RECL=400,FORM='UNFORMATTED',
+     * ACCESS='DIRECT',STATUS='OLD')
+C      DEFINE FILE 11(10000,346,U,IUUU)                                  TEQ01590
+C      DEFINE FILE 11(30000,346,U,IUUU)                                  TEQ01590
+      OPEN(UNIT=11,FILE='ZNOMEN.DAT',ACCESS='DIRECT',
+     * RECL=692,STATUS='OLD',FORM='UNFORMATTED')
+C      DEFINE FILE 12(400,1584,U,IC12)                                   TEQ01600
+      OPEN(UNIT=12,FILE='MAT.SOM',ACCESS='DIRECT',
+     * RECL=3168,STATUS='OLD',FORM='UNFORMATTED')
+C      DEFINE FILE 13(4000,52,U,IC13)                                    TEQ01610
+      OPEN(UNIT=13,FILE='ATA.SOM',ACCESS='DIRECT',
+     * RECL=104,STATUS='OLD',FORM='UNFORMATTED')
+C      DEFINE FILE 15(1100,1600,U,IC15)                                  TEQ01620
+      OPEN(UNIT=15,FILE='PRO.SOM',ACCESS='DIRECT',
+     * STATUS='OLD',FORM='UNFORMATTED',RECL=3200)
+C      DEFINE FILE 16(2000,40,U,IC16)                                    TEQ01630
+      OPEN (FILE='FER.SOM',UNIT=16,RECL=80,FORM='UNFORMATTED',
+     * ACCESS='DIRECT',STATUS='OLD')
+      DEFINE FILE 17(600,1240,U,IC17)                                   TEQ01640
+C      OPEN (FILE='RONDELLE.DAT',UNIT=17,RECL=2480,FORM='UNFORMATTED',
+C     * ACCESS='DIRECT',STATUS='OLD')
+                                                                        TEQ01650
+ 2000 FORMAT(80A1)                                                      TEQ02300
+ 3002 FORMAT(10X,80A1)                                                  TEQ02310
+ 3000 FORMAT('1C8:  NOMBRE D UNITES TEQUILA ',I4,' NOEUDS',I4,' BARRES')TEQ02320
+ 3001 FORMAT(' C9:',2F10.2,F10.6,2F10.2,'HORS DESSIN',F10.2,' TOTAL ',  TEQ02330
+     *F10.2)                                                            TEQ02340
+
+C      CALL DAREAD(IBUF,80,200,15)
+C      write(*,*) IBUF(1:80)
+C      write(*,*) "PEDRO"
+C                                                                       TEQ02350
+      DO 9999 I=1,20                                                    TEQ02360
+      IUNIT(I)=I                                                        TEQ02370
+ 9999 CONTINUE                                                          TEQ02380
+      IESP=0                                                            TEQ02430
+      IQUAL=0                                                           TEQ02440
+      IARCH=0                                                           TEQ02450
+      ICAS=0                                                            TEQ02460
+      ISUP=0                                                            TEQ02470
+      INORD=0                                                           TEQ02480
+      IDIN=0                                                            TEQ02490
+      INTAX=0                                                           TEQ02500
+      IBART=2                                                           TEQ02510
+      IBUF(1)=3                                                         TEQ02520
+      ILANG=0                                                           TEQ02530
+      ITEST=0                                                           TEQ02540
+      MPER=0                                                            TEQ02550
+      IFEET=0                                                           TEQ02560
+      NSTUD=0                                                           TEQ02570
+      NPERM=0                                                           TEQ02580
+      IATA=1                                                            TEQ02590
+      JPROJ=0                                                           TEQ02600
+      KLAS(1)=0                                                         TEQ02610
+      MARG=0                                                            TEQ02620
+      NLABEL=0                                                          TEQ02630
+      INUAN(1)=JNUAN(1)                                                 TEQ02640
+      INUAN(2)=JNUAN(2)                                                 TEQ02650
+C                                                                       TEQ02660
+      ILIST=0                                                           TEQ02670
+      NDUP=0                                                            TEQ02680
+      CALL TAB(NBRD,1,400,0,0)                                          TEQ02690
+      IRAIDS=1                                                          TEQ02700
+      CALL OVLY(TEQ1,IRC)                                               TEQ02710
+      CALL OVLY(TEQ2,IRC)                                               TEQ02720
+      CALL OVLY(TEQZ,IRC)                                               TEQ02730
+C                                                                       TEQ02740
+C                                                                       TEQ02830
+      CALL IBENA(IBUF,270,IUNI7)                                        TEQ02840
+      CALL TAB(IBUF,301,1804,0,0)                                       TEQ02850
+      PO=60.                                                            TEQ02860
+      PA=0.                                                             TEQ02870
+      P2=0.0005                                                         TEQ02880
+      M=0                                                               TEQ02890
+      INOM=0                                                            TEQ02900
+      CALL PNUMA(0.,0.,M,-0.5,-0.5)                                     TEQ02910
+      CALL PCARA(-.1,1.8,0,ILABEL,                                      TEQ02920
+     *40,0.2,0.3,0.,1.)                                                 TEQ02930
+      IU17=-IUNI17                                                      TEQ02940
+      CALL DAWRIT(IBUF,2480,IC17,IU17)                                  TEQ02950
+C      write(*,*) INPUT, IUNIT(:)
+      CALL CARTOU                                                       TEQ02960
+CDH
+      DO I=1,7
+C         CALL DROOG2
+      END DO
+      CALL TAB(KX,1,500,0.,0)                                           TEQ02970
+      N=0                                                               TEQ02980
+      KLOAD=1                                                           TEQ02990
+    1 ILOAD=KLOAD                                                       TEQ03000
+      READ(INPUT,2000,END=115)KART                                      TEQ03010
+      WRITE(IUNI3,3002)KART                                             TEQ03030
+      KI=1                                                              TEQ03040
+      KF=80                                                             TEQ03050
+      CALL TEXTZ(KART,KI,80,ESP,JOB)                                    TEQ03060
+      IF(JOB    .EQ.0)GO TO  777                                        TEQ03070
+      IF(JOB.EQ.1)IESP=1                                                TEQ03080
+  777 CONTINUE                                                          TEQ03090
+      CALL TEXTZ(KART,KI,80,PIED,JOB)                                   TEQ03100
+      IF(JOB    .EQ.0)GO TO  1                                          TEQ03110
+      IF(JOB.LT.3)IFEET=JOB                                             TEQ03120
+      CALL TEXTZ(KART,KI,80,JDIN,KOD0)                                  TEQ03130
+      IF(KOD0.EQ.1)IDIN=1                                               TEQ03140
+      IF(KOD0.EQ.2)IDIN=2                                               TEQ03150
+      CALL TEXTZ(KART,KI,80,DICO,JOB)                                   TEQ03160
+      IF(JOB    .EQ.0)GO TO  1                                          TEQ03170
+C                                                                       TEQ03180
+C        1 NOEUD   2 POTEAU  3 BARRE                                    TEQ03190
+C        4 TREMY   5 PERCA   6 COMMENTAIRES                             TEQ03200
+C        7 COTAT   8 REPERAGE9 NOTA                                     TEQ03210
+C       10 AXE    11 TROU   12 FIN                                      TEQ03220
+C       13 NOMEN  14 CONTOUR15 ARCHI                                    TEQ03230
+C       16 EPURE  17 MONTA  18 AJOUTER                                  TEQ03240
+C       19 DETAIL 20 ARC    21 CLOU                                     TEQ03250
+C       22 CARTOU 23 FLECHE 24 **BOULON                                 TEQ03260
+C       25 GOUJON 26 TEST   27 **OFF                                    TEQ03270
+C       28 LISTER 29 NORD  30 ENTRE AXE                                 TEQ03280
+C       31 NUANCE 32 DUPLICATION                                        TEQ03290
+C       33 CLASSE 34 PROJET 35 MARGE                                    TEQ03300
+C       36 START  37 REJET                                              TEQ03310
+C                                                                       TEQ03320
+C      NOMBRE MAXI DE MOTS CLEFS                                        TEQ03330
+C                                                                       TEQ03340
+      IF(JOB.EQ.35)MARG=1                                               TEQ03350
+      IF(JOB.GT.37)GO TO 1                                              TEQ03360
+      KLOAD=LLOAD(JOB)                                                  TEQ03370
+      IF(JOB.LE.3)GO TO(2,14,3),JOB                                     TEQ03380
+      IF(JOB.EQ.12)GO TO 15                                             TEQ03390
+      IF(JOB.EQ.13)GO TO 16                                             TEQ03400
+      IF(JOB.EQ.15)GO TO 22                                             TEQ03410
+      IF(JOB.EQ.16)GO TO 18                                             TEQ03420
+      IF(JOB.EQ.17)GO TO 20                                             TEQ03430
+      IF(JOB.EQ.19)GO TO 109                                            TEQ03440
+      IF(JOB.EQ.21)GO TO 51                                             TEQ03450
+      IF(JOB.GE.23)GO TO 100                                            TEQ03460
+      CALL OVLY(TEQ0,IRC)                                               TEQ03470
+      CALL OVLY(TEQJ,IRC)                                               TEQ03480
+  100 CONTINUE                                                          TEQ03490
+      GO TO(2,14,3,4,5,6,7,8,9,12,13,15,16,17,22,18,19,21,109,19,51,52, TEQ03500
+     *53,54,55,56,57,58,59,60,61,62,63,64,1,66,37,1),JOB                TEQ03510
+   66 CALL LYS(KART,KI,80,R,IRAIDS,KOD)                                 TEQ03520
+      GO TO 1                                                           TEQ03530
+C                                                                       TEQ03540
+C      DUPLICATION                                                      TEQ03550
+C                                                                       TEQ03560
+   62 CALL OVLY(TEQW,IRC)                                               TEQ03570
+      CALL DUPLC(0)                                                     TEQ03580
+       GO TO 1                                                          TEQ03590
+   61 IF(KART(KI).NE.IBL)GO TO 161                                      TEQ03600
+      KI=KI+1                                                           TEQ03610
+      GO TO 61                                                          TEQ03620
+  161 CALL PACKN(INUAN,4,KART(KI),1,8)                                  TEQ03630
+      GO TO 1                                                           TEQ03640
+   60 INTAX=1                                                           TEQ03650
+      GO TO 1                                                           TEQ03660
+   59 CALL LYS(KART,KI,80,RR,INORD,KOD)                                 TEQ03670
+      IF(INORD.LT.0.OR.INORD.GT.4)INORD=0                               TEQ03680
+      GO TO 1                                                           TEQ03690
+   58 ILIST=1                                                           TEQ03700
+      CALL TEXTZ(KART,KI,80,ITOUT,KOD)                                  TEQ03710
+      IF(KOD.EQ.1)ILIST=2                                               TEQ03720
+      GO TO 1                                                           TEQ03730
+   63 DO 635 I=1,4                                                      TEQ03740
+      KLAS(I)=0                                                         TEQ03750
+      CALL LYS(KART,KI,80,RR,KLAS(I),KOD)                               TEQ03760
+      IF(KOD.EQ.3)KLAS(I)=RR                                            TEQ03770
+  635 CONTINUE                                                          TEQ03780
+      GO TO 1                                                           TEQ03790
+   64 JPROJ=1                                                           TEQ03800
+      GO TO 1                                                           TEQ03810
+C                                                                       TEQ03820
+C      NOEUD                                                            TEQ03830
+C                                                                       TEQ03840
+    2 CONTINUE                                                          TEQ03850
+      IF(KLOAD.EQ.0)KLOAD=ILOAD                                         TEQ03860
+      IF(ILOAD.NE.1)CALL OVLY(TEQ2,IRC)                                 TEQ03870
+      CALL OVLY(TEQZ,IRC)                                               TEQ03880
+      KENTRY=1                                                          TEQ03890
+      CALL TOPOL (KENTRY)                                               TEQ03900
+      GO TO 1                                                           TEQ03910
+C                                                                       TEQ03920
+C      POTEAU                                                           TEQ03930
+C                                                                       TEQ03940
+   14 CONTINUE                                                          TEQ03950
+      IF(ILOAD.GT.2)CALL OVLY(TEQ1,IRC)                                 TEQ03960
+      IF(ILOAD.NE.1)CALL OVLY(TEQ2,IRC)                                 TEQ03970
+      CALL OVLY(TEQZ,IRC)                                               TEQ03980
+      KENTRY=2                                                          TEQ03990
+      CALL TOPOL (KENTRY)                                               TEQ04000
+      GO TO 1                                                           TEQ04010
+C                                                                       TEQ04020
+C      FLECHE                                                           TEQ04030
+C                                                                       TEQ04040
+   53 CONTINUE                                                          TEQ04050
+      IF(ILOAD.GT.2)CALL OVLY(TEQ1,IRC)                                 TEQ04060
+      IF(ILOAD.NE.1)CALL OVLY(TEQ2,IRC)                                 TEQ04070
+      CALL OVLY(TEQZ,IRC)                                               TEQ04080
+      CALL KFLCH(0,N,X,Y,Z)                                             TEQ04090
+      GO TO 1                                                           TEQ04100
+C                                                                       TEQ04110
+C      **OFFSET (COMPATIBILITE KIR)                                     TEQ04120
+C                                                                       TEQ04130
+   57 CONTINUE                                                          TEQ04140
+      IF(ILOAD.NE.1)CALL OVLY(TEQ2,IRC)                                 TEQ04150
+      CALL OVLY(TEQZ,IRC)                                               TEQ04160
+      CALL TOFF                                                         TEQ04170
+      GO TO 1                                                           TEQ04180
+C                                                                       TEQ04190
+C      BARRE                                                            TEQ04200
+C                                                                       TEQ04210
+    3 CONTINUE                                                          TEQ04220
+      IF(ILOAD.GT.2)CALL OVLY(TEQ1,IRC)                                 TEQ04230
+      CALL OVLY(TEQ3,IRC)                                               TEQ04240
+      CALL OVLY(TEQ4,IRC)                                               TEQ04250
+      CALL BARRE                                                        TEQ04260
+      P1=0.38                                                           TEQ04270
+      P3=1.                                                             TEQ04280
+      KP=2                                                              TEQ04290
+      KMETR=1                                                           TEQ04300
+      CALL SISSY(1,IUNI13)                                              TEQ04310
+      CALL OVLY(TEQ5,IRC)                                               TEQ04320
+      KLOAD=8                                                           TEQ04330
+      CALL TABAR                                                        TEQ04340
+  555 CONTINUE                                                          TEQ04350
+      GO TO 1                                                           TEQ04360
+C                                                                       TEQ04370
+C      EPURE                                                            TEQ04380
+C                                                                       TEQ04390
+   18 CONTINUE                                                          TEQ04400
+      IF(ILOAD.GT.2)CALL OVLY(TEQ1,IRC)                                 TEQ04410
+      CALL OVLY(TEQ8,IRC)                                               TEQ04420
+      CALL EPURE                                                        TEQ04430
+      CALL SISSY(1,IUNI13)                                              TEQ04440
+      P1=0.38                                                           TEQ04450
+      P3=1.                                                             TEQ04460
+  107 KMETR=2                                                           TEQ04470
+      GO TO 555                                                         TEQ04480
+C                                                                       TEQ04490
+C      MONTAGE                                                          TEQ04500
+C                                                                       TEQ04510
+   20 CONTINUE                                                          TEQ04520
+      IF(ILOAD.GT.2)CALL OVLY(TEQ1,IRC)                                 TEQ04530
+      CALL OVLY(TEQ9,IRC)                                               TEQ04540
+      CALL MONTA                                                        TEQ04550
+      P1=0.22                                                           TEQ04560
+      CALL SISSY(1,IUNI13)                                              TEQ04570
+      KMETR=2                                                           TEQ04580
+      P2=0.                                                             TEQ04590
+      P3=0.65                                                           TEQ04600
+      GO TO 107                                                         TEQ04610
+C                                                                       TEQ04620
+C      DETAIL (PUNCH)                                                   TEQ04630
+C                                                                       TEQ04640
+  109 CONTINUE                                                          TEQ04650
+C                                                                       TEQ04660
+C      VERIFICATION PUBLIC PRIVE                                        TEQ04670
+C                                                                       TEQ04680
+C                                                                       TEQ04740
+      CALL OVLY(TEQ6,IRC)                                               TEQ04750
+      CALL OVLY(TEQJ,IRC)                                               TEQ04760
+      CALL OVLY(TEQ7,IRC)                                               TEQ04770
+      CALL DTATQ                                                        TEQ04780
+      GO TO 1                                                           TEQ04800
+C                                                                       TEQ04810
+C      DIVERS .......                                                   TEQ04820
+C                                                                       TEQ04830
+    4 KENTRY=1                                                          TEQ04840
+      CALL TREMY (KENTRY)                                               TEQ04850
+      PO=PO+15.                                                         TEQ04860
+      GO TO 1                                                           TEQ04870
+    5 CALL PERCA                                                        TEQ04880
+      PO=PO+3.                                                          TEQ04890
+      GO TO 1                                                           TEQ04900
+    6 CALL TEXTZ(KART,KI,80,DICO,JOB)                                   TEQ04910
+      IF(JOB    .EQ.0)GO TO  1                                          TEQ04920
+      IF(JOB.GT.3)GO TO 7666                                            TEQ04930
+      GO TO(10,6,11),JOB                                                TEQ04940
+ 7666 CONTINUE                                                          TEQ04950
+      KI=KI+1                                                           TEQ04960
+      GO TO 6                                                           TEQ04970
+   10 CALL CONOE                                                        TEQ04980
+      PO=PO+3.                                                          TEQ04990
+      GO TO 1                                                           TEQ05000
+   11 CALL COBAR                                                        TEQ05010
+      PO=PO+3.                                                          TEQ05020
+      GO TO 1                                                           TEQ05030
+    7 CALL COTAT                                                        TEQ05040
+      PO=PO+N*0.05*400.*E                                               TEQ05050
+      GO TO 1                                                           TEQ05060
+    8 CONTINUE                                                          TEQ05070
+C                                                                       TEQ05080
+C      ELIMINER MODULE REPPORT EVENTUEL                                 TEQ05090
+C                                                                       TEQ05100
+      IF(KART(KI).EQ.DICO(3))GO TO 1                                    TEQ05110
+      CALL FILES                                                        TEQ05120
+      PO=PO+N*0.02*400.*E                                               TEQ05130
+      GO TO 1                                                           TEQ05140
+    9 CALL NOTA                                                         TEQ05150
+      PO=PO+3.                                                          TEQ05160
+      GO TO 1                                                           TEQ05170
+   12 CALL AXES(KART,KI,KF)                                             TEQ05180
+      PO=PO+10.                                                         TEQ05190
+      GO TO 1                                                           TEQ05200
+   13 KENTRY=2                                                          TEQ05210
+      CALL TREMY (KENTRY)                                               TEQ05220
+      PO=PO+10.                                                         TEQ05230
+      GO TO 1                                                           TEQ05240
+C                                                                       TEQ05250
+C      CLOU                                                             TEQ05260
+C                                                                       TEQ05270
+   51 CALL LYS(KART,KI,80,R,IBART,KOD)                                  TEQ05280
+      KI=KI+1                                                           TEQ05290
+      IF(KOD.EQ.4)GO TO 51                                              TEQ05300
+      IPH5=0                                                            TEQ05310
+      KI=KI-1                                                           TEQ05320
+  151 CALL LYS(KART,KI,80,R,IPH5,KOD)                                   TEQ05330
+      IF(KOD.NE.2)GO TO 1                                               TEQ05340
+      IBART=IBART+10*IPH5                                               TEQ05350
+      CALL LYS(KART,KI,80,R,IQUAL,KOD)                                  TEQ05360
+      IF(KOD.NE.2)IQUAL=0                                               TEQ05370
+      GO TO 1                                                           TEQ05380
+C                                                                       TEQ05390
+C      CARTOUCHE SPECIAL                                                TEQ05400
+C                                                                       TEQ05410
+   52 CALL CARLC(0)                                                     TEQ05420
+      GO TO 1                                                           TEQ05430
+C                                                                       TEQ05440
+C      NOMENCLATURE                                                     TEQ05450
+C                                                                       TEQ05460
+   16 INOM=1                                                            TEQ05470
+   50 CALL LYS(KART,KI,80,R,INOM,KOD)                                   TEQ05480
+      KI=KI+1                                                           TEQ05490
+      IF(KOD-2)1,1,50                                                   TEQ05500
+   17 CALL BMETA                                                        TEQ05510
+      PO=PO+30.                                                         TEQ05520
+      GO TO 1                                                           TEQ05530
+   19 CALL AMETA                                                        TEQ05540
+      PO=PO+30.                                                         TEQ05550
+      GO TO 1                                                           TEQ05560
+   21 CONTINUE                                                          TEQ05570
+      NPER=MPER                                                         TEQ05580
+      CALL PERRA                                                        TEQ05590
+      MPER=NPER                                                         TEQ05600
+      GO TO 1                                                           TEQ05610
+   22 IARCH=1                                                           TEQ05620
+      GO TO 1                                                           TEQ05630
+C                                                                       TEQ05640
+C     **BOULON   (COMPATIBILITE KIR)                                    TEQ05650
+C                                                                       TEQ05660
+   54 CONTINUE                                                          TEQ05670
+      CALL OVLY(TEQW,IRC)                                               TEQ05680
+      CALL BOUDES(KART,KI)                                              TEQ05690
+      GOTO 1                                                            TEQ05700
+C                                                                       TEQ05710
+C      GOUJON                                                           TEQ05720
+C                                                                       TEQ05730
+   55 CONTINUE                                                          TEQ05740
+      CALL OVLY(TEQW,IRC)                                               TEQ05750
+      CALL STUDS(NSTUD,ISTUD)                                           TEQ05760
+      GO TO 1                                                           TEQ05770
+   56 ITEST=1                                                           TEQ05780
+      GO TO 1                                                           TEQ05790
+C                                                                       TEQ05800
+C      REJET                                                            TEQ05810
+C                                                                       TEQ05820
+   37  CALL REJET                                                       TEQ05830
+       write(*,*) "PEDRO: REJET fini"
+       GO TO 1                                                          TEQ05840
+C                                                                       TEQ05850
+C                                                                       TEQ05860
+  115 IATA=2                                                            TEQ05870
+C                                                                       TEQ05880
+C      FIN DU DESSIN,DEBUT DU TRAITEMENT DES FICHES ET DES NOMENCLATURESTEQ05890
+C                                                                       TEQ05900
+   15 CALL POSA(U,V)                                                    TEQ05910
+      IN=N                                                              TEQ05920
+      IP=IC14-6                                                         TEQ05930
+      CALL OVLY(TEQ0,IRC)                                               TEQ05940
+      CALL OVLY(TEQ2,IRC)                                               TEQ05950
+      CALL TPOS                                                         TEQ05960
+      N99=999                                                           TEQ05970
+      CALL PNUMA(0.,0.,N99,0.,0.)                                       TEQ05980
+C                                                                       TEQ05990
+C      FIN SI PASSAGE DE TEST SANS NOMENCLATURE OU FICHE                TEQ06000
+C                                                                       TEQ06010
+C                                                                       TEQ06060
+      IF(ITEST.EQ.1)STOP                                                TEQ06070
+      CALL OVLY(TEQI,IRC)                                               TEQ06080
+      IF(IARCH.EQ.1)CALL ARCHI                                          TEQ06100
+      INOM1=INOM                                                        TEQ06120
+      IF(INOM.EQ.0)INOM=1                                               TEQ06130
+      IF(INOM)35,35,34                                                  TEQ06140
+   34 CONTINUE                                                          TEQ06150
+      IF(KMETR.EQ.2)GO TO 134                                           TEQ06160
+      N=IN                                                              TEQ06170
+      CALL OVLY(TEQB,IRC)                                               TEQ06180
+      CALL OVLY(TEQF,IRC)                                               TEQ06190
+      CALL OVLY(TEQM,IRC)                                               TEQ06200
+      NPER=MPER                                                         TEQ06210
+      ITEST=INTAX                                                       TEQ06220
+      CALL GRUGE                                                        TEQ06230
+      CALL OVLY(TEQC,IRC)                                               TEQ06240
+      CALL OVLY(TEQD,IRC)                                               TEQ06250
+      CALL OVLY(TEQL,IRC)                                               TEQ06260
+      KARM=0                                                            TEQ06270
+      CALL GRUF(KARM)                                                   TEQ06280
+      PA=1.0+0.7*IW28                                                   TEQ06290
+      N=IN                                                              TEQ06300
+      IECHW=2-KMETR                                                     TEQ06310
+      INOM=INOM1                                                        TEQ06320
+  134 CONTINUE                                                          TEQ06330
+      IF(INOM1.EQ.0)GOTO 33                                             TEQ06340
+      CALL OVLY(TEQA,IRC)                                               TEQ06350
+      CALL OVLY(TEQK,IRC)                                               TEQ06360
+      CALL OVLY(TEQE,IRC)                                               TEQ06370
+C                                                                       TEQ06400
+      IBUF(1)=0                                                         TEQ06410
+      CALL POUT(IBUF)                                                   TEQ06420
+      CALL MAYAN                                                        TEQ06430
+      PA=PA+0.05                                                        TEQ06440
+      IF(KMETR.EQ.2)GO TO 33                                            TEQ06450
+      IF((NPER+NPERM).GT.0)GO TO 133                                    TEQ06460
+      IF(IC13)33,33,133                                                 TEQ06470
+  133 CONTINUE                                                          TEQ06480
+      CALL OVLY(TEQG,IRC)                                               TEQ06490
+      CALL BULON                                                        TEQ06500
+      CALL OVLY(TEQH,IRC)                                               TEQ06510
+      PA=PA+0.25                                                        TEQ06520
+      CALL MAYEN                                                        TEQ06530
+      GOTO 33                                                           TEQ06550
+ 35   IF(IW28.NE.0)GOTO 34                                              TEQ06560
+ 33   N=IN                                                              TEQ06570
+      STOP                                                              TEQ06680
+      END                                                               TEQ06690
+      SUBROUTINE TPOS                                                   TEQ06700
+C                                                                       TEQ06710
+C      VERSION FEVRIER 1986                                             TEQ06720
+C        TEQ.FT0                                                        TEQ06730
+C                                                                       TEQ06740
+      COMMON /SUITW/ XW,YW,XNIV,INIVO,IOP,IQT,XBAR,ICADR                TEQ06750
+      COMMON /DIVER/ ISUP,ILANG,IW28,W1,IKOT(5)                         TEQ06760
+      COMMON /RAIDIS/NBRE(400)                                                  
+      COMMON /OPTCD/IDUM,ITEST,VBD(2),IRAIDS                            TEQ06780
+      COMMON /CARTO/ICAS,XCAR(3,8),ITTRR(74)                            TEQ06790
+      COMMON /PLACE/IPPAG,ICLIEN(56),IDAT(2),IAFF(2),NUMRO(7)           TEQ06800
+C                                                                       TEQ06810
+      DIM=80.+2.*IKOT(4)                                                TEQ06820
+      NCASE=3                                                           TEQ06830
+      IF(DIM.LT.90.)NCASE=2                                             TEQ06840
+      XECR=138.+21.*ICADR-XW                                            TEQ06850
+      CALL CARTC(0,XECR-20.,-YW)                                        TEQ06860
+      CALL PLUME(0)                                                     TEQ06870
+      NB=99                                                             TEQ06880
+      IDXX=0                                                            TEQ06890
+C     IF(NRAID.GT.0)NB=NB-1                                             TEQ06900
+      CALL PNUMA(XECR,-YW,NB,0.,0.)                                     TEQ06910
+C     WRITE(6,7786)ITEST                                                        
+C7786 FORMAT(' ITEST=',I12)                                                     
+      IF(ITEST.EQ.1)GO TO 1                                             TEQ06930
+      CALL PACKN(IAFF,4,ITTRR(1),2,4)                                   TEQ06940
+      CALL PACKN(IDAT,4,ITTRR(64),2,4)                                  TEQ06950
+      DO 2 I=1,56                                                       TEQ06960
+    2 ICLIEN(I)=ITTRR(I+4)                                              TEQ06970
+      DO 3 I=1,7                                                        TEQ06980
+    3 NUMRO(I)=ITTRR(I+67)                                              TEQ06990
+      CALL RAIDF(-10.,0.,NCASE,NRAID)                                         TE
+      IDXX=(NRAID+NCASE-1)/NCASE                                        TEQ07010
+    1 CONTINUE                                                          TEQ07020
+      DXX=IDXX*21.+IDXX/5*1.                                            TEQ07030
+      CALL PNUMA(DXX,0.,NB,0.,0.)                                       TEQ07040
+      RETURN                                                            TEQ07050
+      END                                                               TEQ07060
+      SUBROUTINE REJET                                                  TEQ07070
+C                                                                       TEQ07080
+C                                                                       TEQ07090
+C     COMMANDE REJET                                                    TEQ07100
+C                                                                       TEQ07110
+C      VERSION JUIN 1984 PARIS                                          TEQ07120
+C                                                                       TEQ07130
+      INTEGER DICO(25),KART(80),IREP(2),LABEL(4,200),OUT                TEQ07140
+      DIMENSION RLABEL(4,200)                                           TEQ07150
+      COMMON /REJCOM/LABEL,NLABEL                                       TEQ07160
+      EQUIVALENCE (LABEL(1,1),RLABEL(1,1))                              TEQ07170
+      COMMON/UNIT/INPUT,IDUMMY,OUT                                      TEQ07180
+      DATA DICO /5,'R','E','J','E','T',3,'F','I','N',                   TEQ07190
+     *2,'D','X',2,'D','Y',7,'P','A','R','T','I','E','L',0/              TEQ07200
+      DATA IBL/'    '/,ICOT/''''/,IEGAL/'='/                            TEQ07210
+      INUM=0                                                            TEQ07220
+C                                                                       TEQ07230
+C    DECODAGE CARTE REJET                                               TEQ07240
+C                                                                       TEQ07250
+      INUM=0                                                            TEQ07260
+      KNUM=1                                                            TEQ07270
+  20  READ(INPUT,2000)KART                                              TEQ07280
+      IREJET=0                                                          TEQ07290
+      DX=9999.                                                          TEQ07300
+      DY=9999.                                                          TEQ07310
+ 2000 FORMAT(80A1)                                                      TEQ07320
+      LDEB=1                                                            TEQ07330
+  40  CALL TEXTZ(KART,LDEB,80,DICO,KOD)                                 TEQ07340
+      KI=LDEB                                                           TEQ07350
+      IF(KOD.EQ.2.AND.IREJET.EQ.0)GO TO 500                             TEQ07360
+      IF(KOD.EQ.0)GO TO 20                                              TEQ07370
+      IF(KOD.LE.5)GO TO 10                                              TEQ07380
+      DO 1 I=LDEB,80                                                    TEQ07390
+      IF(KART(I)-ICOT)1,2,1                                             TEQ07400
+    1 CONTINUE                                                          TEQ07410
+    2 I=I+1                                                             TEQ07420
+      IF(I.GT.80)GO TO 20                                               TEQ07430
+      DO 3 J=I,80                                                       TEQ07440
+      IF(KART(J)-ICOT)3,4,3                                             TEQ07450
+    3 CONTINUE                                                          TEQ07460
+      RETURN                                                            TEQ07470
+    4 DO 6 L=1,2                                                        TEQ07480
+    6 IREP(L)=IBL                                                       TEQ07490
+      KK=J-I                                                            TEQ07500
+      CALL PACKN(IREP,4,KART(I),1,KK)                                   TEQ07510
+      INUM=INUM+1                                                       TEQ07520
+      IF(INUM.GT.200)GO TO 333                                          TEQ07530
+      LABEL(1,INUM)=IREP(1)                                             TEQ07540
+      LABEL(2,INUM)=IREP(2)                                             TEQ07550
+C                                                                       TEQ07560
+C                                                                       TEQ07570
+      LDEB=J+1                                                          TEQ07580
+      IF(LDEB.GE.80)GO TO 20                                            TEQ07590
+ 700  DX=9999.                                                          TEQ07600
+      DY=9999.                                                          TEQ07610
+      GO TO 40                                                          TEQ07620
+C                                                                       TEQ07630
+C                                                                       TEQ07640
+C                                                                       TEQ07650
+   10 GO TO (100,200,300,400,110),KOD                                   TEQ07660
+100   CONTINUE                                                          TEQ07670
+      DX=9999.                                                          TEQ07680
+      DY=9999.                                                          TEQ07690
+      CALL TEXTZ(KART,KI,80,DICO,KOD)                                   TEQ07700
+      IF(KOD.NE.5)GO TO 130                                             TEQ07710
+ 110  DX=-9999.                                                         TEQ07720
+      DY=-9999.                                                         TEQ07730
+ 130  IREJET=1                                                          TEQ07740
+      LDEB=KI                                                           TEQ07750
+      GO TO 500                                                         TEQ07760
+200   CONTINUE                                                          TEQ07770
+      NLABEL=INUM                                                       TEQ07780
+      RETURN                                                            TEQ07790
+300   CONTINUE                                                          TEQ07800
+340   CALL LYS(KART,KI,80,R,I,KODE)                                     TEQ07810
+      IF(KODE.EQ.1)GO TO 700                                            TEQ07820
+      IF(KODE.EQ.4.AND.KART(KI).EQ.IEGAL)GO TO 320                      TEQ07830
+      DX=R                                                              TEQ07840
+      IF(KODE.EQ.2)DX=I                                                 TEQ07850
+      LDEB=KI                                                           TEQ07860
+      GO TO 40                                                          TEQ07870
+320   KI=KI+1                                                           TEQ07880
+      GO TO 340                                                         TEQ07890
+C                                                                       TEQ07900
+400   CONTINUE                                                          TEQ07910
+440   CALL LYS(KART,KI,80,R,I,KODE)                                     TEQ07920
+      IF(KODE.EQ.4.AND.KART(KI).EQ.IEGAL)GO TO 420                      TEQ07930
+      DY=R                                                              TEQ07940
+      IF(KODE.EQ.2)DY=I                                                 TEQ07950
+      LDEB=KI                                                           TEQ07960
+      GO TO 500                                                         TEQ07970
+420   KI=KI+1                                                           TEQ07980
+      GO TO 440                                                         TEQ07990
+C                                                                       TEQ08000
+C   MISE A JOUR TABLEAU LABEL                                           TEQ08010
+C                                                                       TEQ08020
+500    DO 501 LN=KNUM,INUM                                              TEQ08030
+       RLABEL(3,LN)=DX                                                  TEQ08040
+       RLABEL(4,LN)=DY                                                  TEQ08050
+501    CONTINUE                                                         TEQ08060
+       KNUM=INUM+1                                                      TEQ08070
+       IF(KOD.EQ.2)GO TO 200                                            TEQ08080
+       GO TO 40                                                         TEQ08090
+ 333   WRITE(OUT,633)                                                   TEQ08100
+ 633   FORMAT('  E : PLUS DE 200 REPERES ')                             TEQ08110
+       WRITE(2,634)                                                     TEQ08100
+ 634   FORMAT('  E : PLUS DE 200 REPERES ')                             TEQ08110
+       RETURN                                                           TEQ08120
+      END                                                               TEQ08130