| 1 | PROGRAM rejouer |
|---|
| 2 | |
|---|
| 3 | USE mod_const_mpi, ONLY: comm_lmdz |
|---|
| 4 | USE inigeomphy_mod, ONLY: inigeomphy |
|---|
| 5 | USE comvert_mod, ONLY: presnivs |
|---|
| 6 | USE comvert_mod, only : preff, pa |
|---|
| 7 | |
|---|
| 8 | |
|---|
| 9 | |
|---|
| 10 | implicit none |
|---|
| 11 | #include "dimensions.h" |
|---|
| 12 | |
|---|
| 13 | real :: airefi |
|---|
| 14 | real :: zcufi = 1. |
|---|
| 15 | real :: zcvfi = 1. |
|---|
| 16 | real :: rlat_rad(1),rlon_rad(1) |
|---|
| 17 | |
|---|
| 18 | integer ntime |
|---|
| 19 | integer jour0,mois0,an0 |
|---|
| 20 | integer it |
|---|
| 21 | integer klev,klon |
|---|
| 22 | |
|---|
| 23 | !--------------------------------------------------------------------- |
|---|
| 24 | ! L'appel a inigeomphy n'est utile que pour avoir getin_p dans |
|---|
| 25 | ! les initialisations |
|---|
| 26 | !--------------------------------------------------------------------- |
|---|
| 27 | zcufi=1. |
|---|
| 28 | zcvfi=1. |
|---|
| 29 | rlat_rad(1)=0. |
|---|
| 30 | rlon_rad(1)=0. |
|---|
| 31 | |
|---|
| 32 | preff=101325. |
|---|
| 33 | pa=50000. |
|---|
| 34 | open(82,file='dump_param.bin',form='unformatted',status='old') |
|---|
| 35 | CALL disvert() |
|---|
| 36 | CALL inigeomphy(1,1,llm, & |
|---|
| 37 | 1, comm_lmdz, & |
|---|
| 38 | (/rlat_rad(1),0./),(/0./), & |
|---|
| 39 | (/0.,0./),(/rlon_rad(1),0./), & |
|---|
| 40 | (/ (/airefi,0./),(/0.,0./) /), & |
|---|
| 41 | (/zcufi,0.,0.,0./), & |
|---|
| 42 | (/zcvfi,0./)) |
|---|
| 43 | |
|---|
| 44 | CALL suphel |
|---|
| 45 | ntime=100 |
|---|
| 46 | jour0=1 |
|---|
| 47 | mois0=1 |
|---|
| 48 | an0=2000 |
|---|
| 49 | klon=1 |
|---|
| 50 | klev=llm |
|---|
| 51 | call iotd_ini('phys.nc',1,1,klev,0.,0.,presnivs,jour0,mois0,an0,0.,900.,'360d') |
|---|
| 52 | |
|---|
| 53 | !--------------------------------------------------------------------- |
|---|
| 54 | ! Initialisation de la parametrisation |
|---|
| 55 | !--------------------------------------------------------------------- |
|---|
| 56 | call get_ini_module |
|---|
| 57 | |
|---|
| 58 | !--------------------------------------------------------------------- |
|---|
| 59 | ! Boucle en temps sur l'appel à la parametrisation |
|---|
| 60 | !--------------------------------------------------------------------- |
|---|
| 61 | DO it=1,ntime |
|---|
| 62 | print*,'Pas de temps ',it,klon,klev |
|---|
| 63 | call call_param_replay(klon,klev) |
|---|
| 64 | ENDDO |
|---|
| 65 | END |
|---|
| 66 | |
|---|
| 67 | |
|---|
| 68 | !--------------------------------------------------------------------- |
|---|
| 69 | !///////////////////////////////////////////////////////////////////// |
|---|
| 70 | !///////////////////////////////////////////////////////////////////// |
|---|
| 71 | ! routine additionnelles utiles, prises dans 1DUTILS.h |
|---|
| 72 | !///////////////////////////////////////////////////////////////////// |
|---|
| 73 | !///////////////////////////////////////////////////////////////////// |
|---|
| 74 | !--------------------------------------------------------------------- |
|---|
| 75 | |
|---|
| 76 | !======================================================================= |
|---|
| 77 | SUBROUTINE abort_gcm(modname, message, ierr) |
|---|
| 78 | USE IOIPSL |
|---|
| 79 | ! Stops the simulation cleanly, closing files and printing various |
|---|
| 80 | ! comments |
|---|
| 81 | !======================================================================= |
|---|
| 82 | ! |
|---|
| 83 | ! Input: modname = name of calling program |
|---|
| 84 | ! message = stuff to print |
|---|
| 85 | ! ierr = severity of situation ( = 0 normal ) |
|---|
| 86 | |
|---|
| 87 | character(len=*) modname |
|---|
| 88 | integer ierr |
|---|
| 89 | character(len=*) message |
|---|
| 90 | |
|---|
| 91 | write(*,*) 'in abort_gcm' |
|---|
| 92 | call histclo |
|---|
| 93 | write(*,*) 'out of histclo' |
|---|
| 94 | write(*,*) 'Stopping in ', modname |
|---|
| 95 | write(*,*) 'Reason = ',message |
|---|
| 96 | call getin_dump |
|---|
| 97 | ! |
|---|
| 98 | if (ierr .eq. 0) then |
|---|
| 99 | write(*,*) 'Everything is cool' |
|---|
| 100 | else |
|---|
| 101 | write(*,*) 'Houston, we have a problem ', ierr |
|---|
| 102 | endif |
|---|
| 103 | STOP |
|---|
| 104 | END |
|---|
| 105 | |
|---|
| 106 | !======================================================================= |
|---|
| 107 | SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi) |
|---|
| 108 | IMPLICIT NONE |
|---|
| 109 | ! passage d'un champ de la grille scalaire a la grille physique |
|---|
| 110 | !======================================================================= |
|---|
| 111 | |
|---|
| 112 | !----------------------------------------------------------------------- |
|---|
| 113 | ! declarations: |
|---|
| 114 | ! ------------- |
|---|
| 115 | |
|---|
| 116 | INTEGER im,jm,ngrid,nfield |
|---|
| 117 | REAL pdyn(im,jm,nfield) |
|---|
| 118 | REAL pfi(ngrid,nfield) |
|---|
| 119 | |
|---|
| 120 | INTEGER j,ifield,ig |
|---|
| 121 | |
|---|
| 122 | !----------------------------------------------------------------------- |
|---|
| 123 | ! calcul: |
|---|
| 124 | ! ------- |
|---|
| 125 | |
|---|
| 126 | IF(ngrid.NE.2+(jm-2)*(im-1).AND.ngrid.NE.1) & |
|---|
| 127 | & STOP 'probleme de dim' |
|---|
| 128 | ! traitement des poles |
|---|
| 129 | CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid) |
|---|
| 130 | CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid) |
|---|
| 131 | |
|---|
| 132 | ! traitement des point normaux |
|---|
| 133 | DO ifield=1,nfield |
|---|
| 134 | DO j=2,jm-1 |
|---|
| 135 | ig=2+(j-2)*(im-1) |
|---|
| 136 | CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1) |
|---|
| 137 | ENDDO |
|---|
| 138 | ENDDO |
|---|
| 139 | |
|---|
| 140 | RETURN |
|---|
| 141 | END |
|---|
