Concepts 3.0 : Différence entre versions

Un article de Informaticiens département des sciences de la Terre et l'atmosphère
Aller à: navigation, charcher
m (→‎SETUP NEMO/OPA avec concepts 3.0 / 3.1)
m (→‎SETUP NEMO/OPA avec concepts 3.0 / 3.1.0 / 3.1.3)
 
(11 révisions intermédiaires par le même utilisateur non affichées)
Ligne 1: Ligne 1:
 
== NEMO/OPA ==
 
== NEMO/OPA ==
  
−
=== SETUP NEMO/OPA avec concepts 3.0 / 3.1 ===
+
=== SETUP NEMO/OPA avec concepts 3.0 / 3.1.0 / 3.1.3 ===
 
<pre>
 
<pre>
 
concepts 3.0
 
concepts 3.0
Ligne 7: Ligne 7:
 
concepts 3.1
 
concepts 3.1
 
   source s.ssmuse.dot concepts-3.1 (guillimin/st/skynet/beluga/postes de travail)
 
   source s.ssmuse.dot concepts-3.1 (guillimin/st/skynet/beluga/postes de travail)
 +
concepts 3.1.3
 +
  source s.ssmuse.dot OCE/concepts-3.1.3 (guillimin)
  
 
s'assurer que le répertoire $HOME/data/$TRUE_HOST existe et n'est pas sur le même "filesystem" que $HOME
 
s'assurer que le répertoire $HOME/data/$TRUE_HOST existe et n'est pas sur le même "filesystem" que $HOME
 +
(concepts 3.1.3 utilise le compilateur Intel version 16)
  
 
true_path -n $HOME
 
true_path -n $HOME
Ligne 36: Ligne 39:
 
       et créer des erreurs de toutes sortes.
 
       et créer des erreurs de toutes sortes.
  
−
install_concepts.ksh  
+
install_concepts.ksh           # portion qui ne dépend pas de la machine
−
install_concepts.ksh  -arch
+
install_concepts.ksh  -arch   # portion qui dépend de la machine
  
 
/bin/rm -rf $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/modeles/NEMO/WORK
 
/bin/rm -rf $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/modeles/NEMO/WORK
Ligne 44: Ligne 47:
  
 
vi $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/util/AA_make.gdef  #params generaux de compilation selon les architectures
 
vi $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/util/AA_make.gdef  #params generaux de compilation selon les architectures
−
(en mode couple, ca prend  
+
 
 +
(en mode couplé avec GEM, ca prend  
 
#-Q- linux64  ARMN_LIB= -lrpn_comm_40510 -lrmn_015 -lmassvp4
 
#-Q- linux64  ARMN_LIB= -lrpn_comm_40510 -lrmn_015 -lmassvp4
 
ou l'equivalent)
 
ou l'equivalent)
Ligne 51: Ligne 55:
 
fait_config CMC  # ajustement de WORK
 
fait_config CMC  # ajustement de WORK
  
 +
#
 +
#  refaire à partir d'ici si on change la configuration ou si on ajoute de nouveaux fichiers de code
 +
#
 
cd $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/modeles/NEMO
 
cd $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/modeles/NEMO
 
../UTIL/fait_AA_make  # aller prendre un cafe
 
../UTIL/fait_AA_make  # aller prendre un cafe
  
 
vi $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/config/CMC/scripts/BB_make.ldef    # changer seulement les clefs de compilation prendre ORCA2 comme demo
 
vi $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/config/CMC/scripts/BB_make.ldef    # changer seulement les clefs de compilation prendre ORCA2 comme demo
 +
# dans le même répertoire on trouvera des échantillons de fichiers pré-configurés (ORCA025_CICE_COUPLED.ldef, ORCA1_CICE.ldef, ... ORCA2.ldef)
  
 
cd $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/util  
 
cd $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/util  
Ligne 67: Ligne 75:
 
cd $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/modeles/NEMO/WORK  # nemo seulement
 
cd $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/modeles/NEMO/WORK  # nemo seulement
  
−
make clean # (gmake sur systemes autres que linux)
+
make clean
 
make all
 
make all
  
−
pour trouver l'exécutable opa:
+
pour trouver l'exécutable opa récemment créé :
  
 
find $HOME/data/$TRUE_HOST/ -name 'opa'
 
find $HOME/data/$TRUE_HOST/ -name 'opa'
−
# normalement : $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/bin/Linux_x86-64
+
# normalement : $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/bin/Linux_x86-64/
  
 
</pre>
 
</pre>
Ligne 95: Ligne 103:
 
  NEMO_import.ksh le_fichier.F90
 
  NEMO_import.ksh le_fichier.F90
  
−
nouvelle architecture pgi2014
+
nouvelle architecture de compilation xxxnnn
 
  cd $HOME/data/$TRUE_HOST/CONCEPTS_${CONCEPTS}/data_Linux_x86-64
 
  cd $HOME/data/$TRUE_HOST/CONCEPTS_${CONCEPTS}/data_Linux_x86-64
 
  mkdir -p \
 
  mkdir -p \
−
  ./modipsl/lib/Linux_x86-64/pgi2014/oce \
+
  ./modipsl/lib/Linux_x86-64/xxxnnn/oce \
−
  ./modipsl/bin/Linux_x86-64/pgi2014 \
+
  ./modipsl/bin/Linux_x86-64/xxxnnn \
−
  ./modipsl/libcice_2.0.1/Linux_x86-64/pgi2014 \
+
./modipsl/libcice_2.3.3/Linux_x86-64/xxxnnn \
−
  ./modipsl/libcice_2.2.0/Linux_x86-64/pgi2014
+
  ./modipsl/libcice_2.0.1/Linux_x86-64/xxxnnn \
 +
  ./modipsl/libcice_2.2.0/Linux_x86-64/xxxnnn
  
 
=== avec CICE ===
 
=== avec CICE ===
 
pour utiliser cice comme modele de glace
 
pour utiliser cice comme modele de glace
−
  s'assurer que le repertoire ${HOME}/CICECMC_2.2.0 n'existe pas
+
  s'assurer que le repertoire ${HOME}/CICECMC_${CICECMC} n'existe pas
 
  install_cice.ksh
 
  install_cice.ksh
−
  cd ${HOME}/CICECMC_2.2.0/cice4.0_cmc
+
  cd ${HOME}/CICECMC_${CICECMC}/cice4.0_cmc
 
  ./clean_ice
 
  ./clean_ice
 
  ./comp_ice.ORCA1_16_square_NEMO_UQAM
 
  ./comp_ice.ORCA1_16_square_NEMO_UQAM
Ligne 118: Ligne 127:
 
  refaire l'executable opa
 
  refaire l'executable opa
  
−
=== calcul des poids d'interpolation ===
+
=== calcul des poids d'interpolation (concepts 3.0) ===
  
 
  # un petit exemple
 
  # un petit exemple

Version actuelle datée du 20 de novembre 2017 à 16:21

NEMO/OPA

SETUP NEMO/OPA avec concepts 3.0 / 3.1.0 / 3.1.3

concepts 3.0
  source s.ssmuse.dot nemo         (guillimin/st/skynet/beluga/postes de travail)
concepts 3.1
  source s.ssmuse.dot concepts-3.1 (guillimin/st/skynet/beluga/postes de travail)
concepts 3.1.3
  source s.ssmuse.dot OCE/concepts-3.1.3 (guillimin)

s'assurer que le répertoire $HOME/data/$TRUE_HOST existe et n'est pas sur le même "filesystem" que $HOME
(concepts 3.1.3 utilise le compilateur Intel version 16)

true_path -n $HOME
et
true_path -n $HOME/data/$TRUE_HOST
ne devraient pas commencer de la même manière

exemple OK:
[user]$ true_path -n $HOME
/sb/home/user
[user]$ true_path -n $HOME/data/$TRUE_HOST
/gs/project/abc-789/user/guillimin                                                                                    

exemple PAS OK:
[user]$ true_path -n $HOME
/sb/home/user
[user]$ true_path -n $HOME/data/$TRUE_HOST
/sb/home/user/data/guillimin                                                                                    


s'assurer que le repertoire $HOME/CONCEPTS_${CONCEPTS} n'existe pas déjà

NOTES: 
 - nemo coexiste mal avec d'autres packages. 
 - ce raccourci charge tous les éléments nécessaires à la production d'un exécutable.
 - la présence d'autres éléments logiciels peut facilement entrer en conflit avec les besoins de nemo
      et créer des erreurs de toutes sortes.

install_concepts.ksh           # portion qui ne dépend pas de la machine
install_concepts.ksh  -arch    # portion qui dépend de la machine

/bin/rm -rf $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/modeles/NEMO/WORK

vi $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/modeles/UTIL/fait_config   # refaire config de code, pas necessaire pour cfg standard

vi $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/util/AA_make.gdef  #params generaux de compilation selon les architectures

(en mode couplé avec GEM, ca prend 
#-Q- linux64  ARMN_LIB= -lrpn_comm_40510 -lrmn_015 -lmassvp4
ou l'equivalent)

cd $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/modeles/UTIL 
fait_config CMC   # ajustement de WORK

#
#  refaire à partir d'ici si on change la configuration ou si on ajoute de nouveaux fichiers de code
#
cd $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/modeles/NEMO
../UTIL/fait_AA_make   # aller prendre un cafe

vi $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/config/CMC/scripts/BB_make.ldef    # changer seulement les clefs de compilation prendre ORCA2 comme demo
# dans le même répertoire on trouvera des échantillons de fichiers pré-configurés (ORCA025_CICE_COUPLED.ldef, ORCA1_CICE.ldef, ... ORCA2.ldef)

cd $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/util 
clr_make 
ins_make -t linux64 #  (-t linux, -t aixp7) 

#cd $HOME/CONCEPTS_${CONCEPTS} 
#. linkme 

cd $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/config/CMC  # premiere compilation

cd $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/modeles/NEMO/WORK  # nemo seulement

make clean
make all

pour trouver l'exécutable opa récemment créé :

find $HOME/data/$TRUE_HOST/ -name 'opa'
# normalement : $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/bin/Linux_x86-64/

Changement de clefs define seulement ==> Refaire a partir de clr_make et ins_make

Ajout de nouvelles clefs ou nouveaux modules ==> Refaire a partir de fait_AA_make

Les nouveaux modules doivent pointer sur des repertoires source de NEMO, ne pas mettre les fichiers dans
$HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/modeles/NEMO/WORK
(voir section gestion du code)

pour la configuration MPI, editer le fichier $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/modeles/NEMO/WORK/par_oce.F90

pour modifier ce fichier, on doit d'abord en obtenir une copie locale en se servant de 

cd $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/modeles/NEMO/WORK
NEMO_import.ksh par_oce.F90

pour modifier tout autre fichier 

cd $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/modeles/NEMO/WORK
NEMO_import.ksh le_fichier.F90

nouvelle architecture de compilation xxxnnn 

cd $HOME/data/$TRUE_HOST/CONCEPTS_${CONCEPTS}/data_Linux_x86-64
mkdir -p \
./modipsl/lib/Linux_x86-64/xxxnnn/oce \
./modipsl/bin/Linux_x86-64/xxxnnn \
./modipsl/libcice_2.3.3/Linux_x86-64/xxxnnn \
./modipsl/libcice_2.0.1/Linux_x86-64/xxxnnn \
./modipsl/libcice_2.2.0/Linux_x86-64/xxxnnn

avec CICE

pour utiliser cice comme modele de glace 

s'assurer que le repertoire ${HOME}/CICECMC_${CICECMC} n'existe pas
install_cice.ksh
cd ${HOME}/CICECMC_${CICECMC}/cice4.0_cmc
./clean_ice
./comp_ice.ORCA1_16_square_NEMO_UQAM
(ou toute autre configuration UQAM)
( comp_ice.CREG025_32_NEMO_UQAM , comp_ice.CREG025_64_NEMO_UQAM , comp_ice.CREG025_144_NEMO_UQAM )
vi $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/config/CMC/scripts/BB_make.ldef
(editer les cles de maniere appropriee)
vi $HOME/CONCEPTS_${CONCEPTS}/nemo3_1_cmc/modipsl/modeles/NEMO/WORK/par_oce.F90
(les configs MPI doivent etre les memes pour NEMO et CICE)
refaire l'executable opa

calcul des poids d'interpolation (concepts 3.0)

# un petit exemple
# fichier de sortie CREG025 , contenant la variable SSH
# fichier de sortie GEM , contenant la variable ZP
sortie_ocean=CREG025-CMC-HCST_y2008m01d05h00m00_gridT2D.std
sortie_atm=OutputReferenceGEM.fst

# poids pour interpoler de OPA a GEM (OPA non global, GEM non global)
cstintrp -fs $sortie_ocean -ns SSH -fstype custom -fr $sortie_atm -nr ZP -fd weights_nemo_to_gem.fst -fdtype rpn -naggrmax  50 -glbsrc F  -owgts T

# poids pour interpoler de GEM a OPA (OPA non global, GEM non global)
cstintrp -fs $sortie_atm -ns ZP -fstype rpn -fr $sortie_ocean -nr SSH  -fd weights_gem_to_nemo.fst -fdtype custom -naggrmax  50 -glbsrc F -owgts T

le résultat OPA -> GEM

voir -iment weights_nemo_to_gem.fst
       NOMV TV   ETIQUETTE        NI      NJ    NK (DATE-O  h m s)           IP1       IP2       IP3     DEET     NPAS  DTY   G   IG1   IG2   IG3   IG4

   0- >>   X  GRDZ              470       1     1 00000000 000000           278      1298         0        0        0  E 32  E  1140   620  2704 16000
   1- ^^   X  GRDZ                1     290     1 00000000 000000           278      1298         0        0        0  E 32  E  1140   620  2704 16000
   2- ANG  P@ SEA SURFACE       470     290     1 20080105 000000      15728640         0         0    86400        0  E 32  Z   278  1298     0     0
   3- ANG  @@ SEA SURFACE       470     290     1 20080105 000000      15728640         0         0    86400        0  I  1  Z   278  1298     0     0
   4- LAT  P  SEA SURFACE       470     290     1 20080105 000000      15728640         0         0    86400        0  E 32  Z   278  1298     0     0
   5- LON  P  SEA SURFACE       470     290     1 20080105 000000      15728640         0         0    86400        0  E 32  Z   278  1298     0     0
   6- SSH  P@ SEA SURFACE       470     290     1 20080105 000000      15728640         0         0    86400        0  X 32  Z   278  1298     0     0
   7- NAVG P@ SEA SURFACE       470     290     1 20080105 000000      15728640         0         0    86400        0  X 32  Z   278  1298     0     0
   8- W001 P  WEIGHTS           470     290     1 20080105 000000      15728640         0         0    86400        0  E 64  Z   278  1298     0     0
   9- I001 P  WEIGHTS           470     290     1 20080105 000000      15728640         0         0    86400        0  I 16  Z   278  1298     0     0
  10- J001 P  WEIGHTS           470     290     1 20080105 000000      15728640         0         0    86400        0  I 16  Z   278  1298     0     0
  11- W002 P  WEIGHTS           470     290     1 20080105 000000      15728640         0         0    86400        0  E 64  Z   278  1298     0     0
  12- I002 P  WEIGHTS           470     290     1 20080105 000000      15728640         0         0    86400        0  I 16  Z   278  1298     0     0
  13- J002 P  WEIGHTS           470     290     1 20080105 000000      15728640         0         0    86400        0  I 16  Z   278  1298     0     0
 .......
  62- W019 P  WEIGHTS           470     290     1 20080105 000000      15728640         0         0    86400        0  E 64  Z   278  1298     0     0
  63- I019 P  WEIGHTS           470     290     1 20080105 000000      15728640         0         0    86400        0  I 16  Z   278  1298     0     0
  64- J019 P  WEIGHTS           470     290     1 20080105 000000      15728640         0         0    86400        0  I 16  Z   278  1298     0     0
  65- W020 P  WEIGHTS           470     290     1 20080105 000000      15728640         0         0    86400        0  E 64  Z   278  1298     0     0
  66- I020 P  WEIGHTS           470     290     1 20080105 000000      15728640         0         0    86400        0  I 16  Z   278  1298     0     0
  67- J020 P  WEIGHTS           470     290     1 20080105 000000      15728640         0         0    86400        0  I 16  Z   278  1298     0     0
  68- SSH  @@ SEA SURFACE       470     290     1 20080105 000000      15728640         0         0    86400        0  I  1  Z   278  1298     0     0
  69- NAVG @@ SEA SURFACE       470     290     1 20080105 000000      15728640         0         0    86400        0  I  1  Z   278  1298     0     0

      NOMV TV   ETIQUETTE        NI      NJ    NK (DATE-O  h m s)           IP1       IP2       IP3     DEET     NPAS  DTY   G   IG1   IG2   IG3   IG4

  70- MASK @@ SEA SURFACE       470     290     1 20080105 000000      15728640         0         0    86400        0  I  1  Z   278  1298     0     0
  71- MAGR @@ SEA SURFACE       470     290     1 20080105 000000      15728640         0         0    86400        0  I  1  Z   278  1298     0     0

le résultat GEM -> OPA

voir -iment weights_gem_to_nemo.fst
      NOMV TV   ETIQUETTE        NI      NJ    NK (DATE-O  h m s)           IP1       IP2       IP3     DEET     NPAS  DTY   G   IG1   IG2   IG3   IG4

   0- >>   PP NEMO-LON          528     603     1 19500101 000000          1001      1002      1003    86400        0  X 32  L   100   100  9000     0
   1- ^^   PP NEMO-LAT          528     603     1 19500101 000000          1001      1002      1003    86400        0  X 32  L   100   100  9000     0
   2- ANG  P@                   528     603     1 00000000 000000             0         0         0        0        0  E 32  X  1001  1002  1003     0
   3- ANG  @@                   528     603     1 00000000 000000             0         0         0        0        0  I  1  X  1001  1002  1003     0
   4- LAT  P                    528     603     1 00000000 000000             0         0         0        0        0  E 32  X  1001  1002  1003     0
   5- LON  P                    528     603     1 00000000 000000             0         0         0        0        0  E 32  X  1001  1002  1003     0
   6- ZP   C@                   528     603     1 00000000 000000             0         0         0        0        0  E 32  X  1001  1002  1003     0
   7- NAVG C@                   528     603     1 00000000 000000             0         0         0        0        0  E 32  X  1001  1002  1003     0
   8- W001 P  WEIGHTS           528     603     1 00000000 000000             0         0         0        0        0  E 64  X  1001  1002  1003     0
   9- I001 P  WEIGHTS           528     603     1 00000000 000000             0         0         0        0        0  I 16  X  1001  1002  1003     0
  10- J001 P  WEIGHTS           528     603     1 00000000 000000             0         0         0        0        0  I 16  X  1001  1002  1003     0
  11- W002 P  WEIGHTS           528     603     1 00000000 000000             0         0         0        0        0  E 64  X  1001  1002  1003     0
  12- I002 P  WEIGHTS           528     603     1 00000000 000000             0         0         0        0        0  I 16  X  1001  1002  1003     0
  13- J002 P  WEIGHTS           528     603     1 00000000 000000             0         0         0        0        0  I 16  X  1001  1002  1003     0
  14- W003 P  WEIGHTS           528     603     1 00000000 000000             0         0         0        0        0  E 64  X  1001  1002  1003     0
  15- I003 P  WEIGHTS           528     603     1 00000000 000000             0         0         0        0        0  I 16  X  1001  1002  1003     0
  16- J003 P  WEIGHTS           528     603     1 00000000 000000             0         0         0        0        0  I 16  X  1001  1002  1003     0
  17- W004 P  WEIGHTS           528     603     1 00000000 000000             0         0         0        0        0  E 64  X  1001  1002  1003     0
  18- I004 P  WEIGHTS           528     603     1 00000000 000000             0         0         0        0        0  I 16  X  1001  1002  1003     0
  19- J004 P  WEIGHTS           528     603     1 00000000 000000             0         0         0        0        0  I 16  X  1001  1002  1003     0
  20- ZP   @@                   528     603     1 00000000 000000             0         0         0        0        0  I  1  X  1001  1002  1003     0
  21- NAVG @@                   528     603     1 00000000 000000             0         0         0        0        0  I  1  X  1001  1002  1003     0
  22- MASK @@                   528     603     1 00000000 000000             0         0         0        0        0  I  1  X  1001  1002  1003     0
  23- MAGR @@                   528     603     1 00000000 000000             0         0         0        0        0  I  1  X  1001  1002  1003     0

fonction d'interpolation

function weighted_interp(d,ni,nj,s,nis,njs,w,ij,np,nmax) result(status)
 implicit none
 integer, intent(IN) :: ni, nj, nmax, nis, njs
 real, intent(OUT), dimension(ni,nj) :: d            ! output grid
 real, intent(IN), dimension(nis*njs) :: s           ! input grid
 real, intent(IN),  dimension(ni,nj,nmax) :: w       ! weights
 integer, intent(IN),  dimension(ni,nj,nmax) :: ij   ! source index table (I and J records from file combined)
 integer, intent(IN),  dimension(ni,nj) :: np        ! number of useful points
 integer :: status
 integer :: i, j, i0, in, k, maxpts
 integer, parameter :: BSIZE=16

 do j = 1 , nj
 do i0 = 1 , ni , BSIZE
   in = min(ni,i0+BSIZE)
   maxpts = maxval(np(i0:in,j))      ! not used for now
   d(i0:in,j) = 0.0
   do k = 1 , nmax
   do i = i0 , in
     d(i,j) = d(i,j) + ( w(i,j,k) * s(ij(i,j,k)) )   ! weighted sum
   enddo
   enddo
 enddo
 enddo
 status = 0
end function weighted_interp

lecture des coefficients du fichier

function read_interp_weights(iun,nis,w) result(status)
 implicit none
 type :: weight_set
   real, dimension(:,:,:), pointer :: w
   real, dimension(:,:), pointer :: c, s
   integer, dimension(:,:,:), pointer :: ij
   integer, dimension(:,:), pointer :: n
   integer :: ni, nj, nmax
 end type
 integer, intent(IN) :: iun          ! weight file
 integer, intent(IN) :: nis          ! first dimension of output grid
 type(weight_set),intent(OUT) :: w
 integer :: status

 real *8, dimension(:,:), allocatable :: w8
 real, dimension(:,:), allocatable :: w4
 integer, dimension(:,:), allocatable :: ia, ja
 integer :: ni, nj, nk, i
 integer, external :: fstinf, fstlir
 character(len=4) :: varname
 real *8 pi, piov180
 real *8, parameter :: ONE=1.0

 pi = acos(-ONE)
 piov180 = pi/180.0
 status = -1

 status = fstinf(iun,ni,nj,nk,-1,"",-1,-1,-1,"P@","NAVG")       ! use NAVG to get dimensions
 print *,"INFO: ni,nj=",ni,nj
 allocate( w%n(ni,nj), w8(ni,nj), w4(ni,nj), ia(ni,nj), ja(ni,nj) )
 status = fstlir( w4,iun,ni,nj,nk,-1,"",-1,-1,-1,"P@","NAVG")   ! number of useful points
 w%n = w4 + 0.5
 w%nmax = maxval(w%n)
 print *,"INFO: w%n  max=",w%nmax
 allocate( w%ij(ni,nj,w%nmax), w%w(ni,nj,w%nmax), w%c(ni,nj), w%s(ni,nj) )
 do i = 1, w%nmax
   write(varname,100)'W',i
   status = fstlir( w8,iun,ni,nj,nk,-1,"",-1,-1,-1,"",varname)   ! Wnnn record
   w%w(:,:,i) = w8
   write(varname,100)'I',i
   status = fstlir( ia,iun,ni,nj,nk,-1,"",-1,-1,-1,"",varname)   ! Innn record
   write(varname,100)'J',i
   status = fstlir( ja,iun,ni,nj,nk,-1,"",-1,-1,-1,"",varname)   ! Jnnn record
   print *,"INFO: ia/ja min,max",minval(ia),maxval(ia),minval(ja),maxval(ja)
   w%ij(:,:,i) = ia + (ja - 1)*nis                               ! I and J combined into "collapsed index"
   print *,"INFO: w%w  min,max=",minval(w%w(:,:,i)),maxval(w%w(:,:,i))
 enddo
 status = fstlir( w%c,iun,ni,nj,nk,-1,"",-1,-1,-1,"P@","ANG")    ! rotation angles
 print *,"INFO: ang  min,max=",minval(w%c),maxval(w%c)
 w%s = sin(w%c * piov180)                                        ! transform into sine and cosine
 w%c = cos(w%c * piov180)
 print *,"INFO: cos  min,max=",minval(w%c),maxval(w%c)
 print *,"INFO: sin  min,max=",minval(w%s),maxval(w%s)
 w%ni = ni
 w%nj = nj

 deallocate(w8,w4,ia,ja)
 status = 0
100 format(A1,I3.3)
end function

programme type

program demo_interp
 implicit none

 type :: weight_set
   real, dimension(:,:,:), pointer :: w
   real, dimension(:,:), pointer :: c, s
   integer, dimension(:,:,:), pointer :: ij
   integer, dimension(:,:), pointer :: n
   integer :: ni, nj, nmax
 end type
 type(weight_set) :: w

 interface
   function read_interp_weights(iun,nis,w) result(status)
     import :: weight_set
     implicit none
     integer, intent(IN) :: iun          ! weight file
     integer, intent(IN) :: nis
     type(weight_set), intent(OUT) :: w
     integer :: status
   end function
 end interface

 real *4, dimension(:,:), allocatable :: sshsrc, sshdest, sshdestref
 integer :: nargs
 character(len=1024) :: old_file, new_file
 integer :: i, status
 integer :: fstdin, fstdout
 integer, external :: fnom, fstouv, fstinf, fstlir, weighted_interp
 integer :: ni, nj, nk, nis, njs, nks
 real *8 pi, piov180
 real *8, parameter :: ONE=1.0

 pi = acos(-ONE)
 piov180 = pi/180.0
 print *,"pi=",pi,piov180
 nargs = command_argument_count()
 if(nargs /= 2) call print_usage
 call GET_COMMAND_ARGUMENT(1,old_file)
 call GET_COMMAND_ARGUMENT(2,new_file)

 print *,'INFO: opening input file '//trim(old_file)
 fstdin = 0
 i = fnom(fstdin,trim(old_file),'STD+RND+OLD',0)
 print *,'DEBUG: fstdin=',fstdin
 i = fstouv(fstdin,'RND')

 print *,'INFO: opening source file '//trim(new_file)
 fstdout = 0
 i = fnom(fstdout,trim(new_file),'STD+RND+OLD',0)
 i = fstouv(fstdout,'RND')

 status = fstinf(fstdout,nis,njs,nks,-1,"",-1,-1,-1,"P@","SSH")
 if(status < 0) goto 777
 allocate(sshsrc(nis,njs))
 print *,"INFO: reading source SSH"
 status = fstlir( sshsrc,fstdout,nis,njs,nks,-1,"",-1,-1,-1,"P@","SSH")
 print *,"INFO: sshsrc  min,max=",minval(sshsrc),maxval(sshsrc)

 status = read_interp_weights(fstdin,nis,w)
 ni = w%ni
 nj = w%nj

 allocate(sshdest(ni,nj),sshdestref(ni,nj))
 status = fstlir( sshdest,fstdin,ni,nj,nk,-1,"",-1,-1,-1,"P@","SSH")
 print *,"INFO: sshdest  min,max=",minval(sshdest),maxval(sshdest)

 status = weighted_interp(sshdestref,ni,nj,sshsrc,nis,njs,w%w,w%ij,w%n,w%nmax)
 call fstecr(sshdestref,sshdestref,-32,fstdin,344189600,0,0,ni,nj,1,0,0,0,'P@','SSH1','DIAGNOSTIQUE','Z',278,1298,0,0,133,.true.)
 print *,"INFO: sshsrc  min,max=",minval(sshsrc),maxval(sshsrc)
 print *,"INFO: sshdest  min,max=",minval(sshdest),maxval(sshdest)
 print *,"INFO: sshdestref  min,max=",minval(sshdestref),maxval(sshdestref)
 sshdestref = sshdestref - sshdest
 print *,"INFO: sshdestdiff  min,max=",minval(sshdestref),maxval(sshdestref)
777 continue
 call fstfrm(fstdin)
 call fstfrm(fstdout)
 stop
end program
Pris de "http://wikiscta.scta.uqam.ca/wikiscta/index.php?title=Concepts_3.0&oldid=2111"