[4094] | 1 | PROGRAM rejouer |
---|
| 2 | |
---|
| 3 | USE mod_const_mpi, ONLY: comm_lmdz |
---|
| 4 | USE inigeomphy_mod, ONLY: inigeomphy |
---|
[4110] | 5 | USE comvert_mod, ONLY: presnivs |
---|
| 6 | USE comvert_mod, only : preff, pa |
---|
[4094] | 7 | |
---|
| 8 | |
---|
[4110] | 9 | |
---|
[4094] | 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. |
---|
[4110] | 31 | |
---|
| 32 | preff=101325. |
---|
| 33 | pa=50000. |
---|
[4113] | 34 | open(82,file='dump_param.bin',form='unformatted',status='old') |
---|
[4110] | 35 | CALL disvert() |
---|
[4094] | 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 |
---|
[4110] | 45 | ntime=100 |
---|
[4094] | 46 | jour0=1 |
---|
| 47 | mois0=1 |
---|
| 48 | an0=2000 |
---|
| 49 | klon=1 |
---|
| 50 | klev=llm |
---|
[4110] | 51 | call iotd_ini('phys.nc',1,1,klev,0.,0.,presnivs,jour0,mois0,an0,0.,900.,'360d') |
---|
[4094] | 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 |
---|