Changeset 5119 for LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d
- Timestamp:
- Jul 24, 2024, 6:46:45 PM (6 months ago)
- Location:
- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90
r5117 r5119 978 978 ENDDO 979 979 980 981 980 END SUBROUTINE dyn1dredem 982 981 983 982 984 983 SUBROUTINE gr_fi_dyn(nfield, ngrid, im, jm, pfi, pdyn) 984 USE lmdz_ssum_scopy, ONLY: scopy 985 985 986 IMPLICIT NONE 986 987 !======================================================================= … … 1016 1017 ENDDO 1017 1018 ENDDO 1018 1019 1019 1020 1020 END SUBROUTINE gr_fi_dyn … … 1469 1469 print *, 't_targ', t_targ 1470 1470 print *, 'rh_targ', rh_targ 1471 1472 1471 1473 1472 END SUBROUTINE nudge_rht_init -
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90
r5117 r5119 561 561 WRITE(*, *) ' ' 562 562 563 end563 END 564 564 SUBROUTINE mesolupbis(file_forctl) 565 565 !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc … … 773 773 774 774 RETURN 775 end775 END 776 776 SUBROUTINE GETSCH(STR, DEL, TRM, NTH, SST, NCH) 777 777 !*************************************************************** -
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h
r5117 r5119 138 138 139 139 RETURN 140 end140 END 141 141 !===================================================================== 142 142 subroutine read_twpice(fich_twpice,nlevel,ntime & … … 534 534 535 535 RETURN 536 end536 END 537 537 !===================================================================== 538 538 … … 647 647 648 648 RETURN 649 end649 END 650 650 !===================================================================== 651 651 SUBROUTINE interp_astex_vertical(play,nlev_astex,plev_prof & … … 1160 1160 1161 1161 RETURN 1162 end1162 END 1163 1163 1164 1164 !===================================================================== … … 1319 1319 1320 1320 RETURN 1321 end1321 END 1322 1322 !***************************************************************************** 1323 1323 !===================================================================== … … 2029 2029 2030 2030 RETURN 2031 end2031 END 2032 2032 !====================================================================== 2033 2033 subroutine readprofile_sandu(nlev_max,kmax,height,pprof,tprof, & -
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/replay1d.F90
r5117 r5119 1 1 PROGRAM rejouer 2 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 USE ioipsl, ONLY: getin 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 USE ioipsl, ONLY: getin 8 9 IMPLICIT NONE 10 INCLUDE "dimensions.h" 11 12 REAL :: airefi 13 REAL :: zcufi = 1. 14 REAL :: zcvfi = 1. 15 REAL :: rlat_rad(1), rlon_rad(1) 16 17 INTEGER ntime 18 INTEGER jour0, mois0, an0, day_step, anneeref, dayref 19 INTEGER klev, klon 20 CHARACTER (len = 10) :: calend 21 CHARACTER(len = 20) :: calendrier 8 22 9 23 24 !--------------------------------------------------------------------- 25 ! L'appel a inigeomphy n'est utile que pour avoir getin_p dans 26 ! les initialisations 27 !--------------------------------------------------------------------- 28 zcufi = 1. 29 zcvfi = 1. 30 rlat_rad(1) = 0. 31 rlon_rad(1) = 0. 10 32 33 preff = 101325. 34 !preff=100000. 35 pa = 50000. 36 CALL disvert() 37 CALL inigeomphy(1, 1, llm, & 38 1, comm_lmdz, & 39 (/rlat_rad(1), 0./), (/0./), & 40 (/0., 0./), (/rlon_rad(1), 0./), & 41 (/ (/airefi, 0./), (/0., 0./) /), & 42 (/zcufi, 0., 0., 0./), & 43 (/zcvfi, 0./)) 11 44 12 IMPLICIT NONE 13 INCLUDE "dimensions.h" 45 CALL suphel 46 !ntime=4320 47 ntime = 10000000 48 dayref = 1 49 anneeref = 2000 50 CALL getin('dayref', dayref) 51 CALL getin('anneeref', anneeref) 52 CALL getin('calend', calend) 53 CALL getin('day_step', day_step) 54 calendrier = calend 55 IF (calendrier == "earth_360d") calendrier = "360_day" 14 56 15 REAL :: airefi 16 REAL :: zcufi = 1. 17 REAL :: zcvfi = 1. 18 REAL :: rlat_rad(1),rlon_rad(1) 57 jour0 = dayref 58 mois0 = (jour0 - 1) / 30 + 1 59 jour0 = jour0 - 30 * ((jour0 - 1) / 30) 60 an0 = anneeref 19 61 20 INTEGER ntime 21 INTEGER jour0,mois0,an0,day_step,anneeref,dayref 22 INTEGER klev,klon 23 CHARACTER (len=10) :: calend 24 CHARACTER(len=20) :: calendrier 62 !PRINT*,"REPLAY1D jour0,mois0,an0",jour0,mois0,an0 25 63 64 klon = 1 65 klev = llm 66 CALL iotd_ini('phys.nc', 1, 1, klev, 0., 0., presnivs, jour0, mois0, an0, 0., 86400. / day_step, calendrier) 67 ! Consistent with ... CALL iophys_ini(600.) 26 68 27 !--------------------------------------------------------------------- 28 ! L'appel a inigeomphy n'est utile que pour avoir getin_p dans 29 ! les initialisations 30 !--------------------------------------------------------------------- 31 zcufi=1. 32 zcvfi=1. 33 rlat_rad(1)=0. 34 rlon_rad(1)=0. 69 !--------------------------------------------------------------------- 70 ! Initialisation de la parametrisation 71 !--------------------------------------------------------------------- 72 CALL call_ini_replay 35 73 36 preff=101325. 37 !preff=100000. 38 pa=50000. 39 CALL disvert() 40 CALL inigeomphy(1,1,llm, & 41 1, comm_lmdz, & 42 (/rlat_rad(1),0./),(/0./), & 43 (/0.,0./),(/rlon_rad(1),0./), & 44 (/ (/airefi,0./),(/0.,0./) /), & 45 (/zcufi,0.,0.,0./), & 46 (/zcvfi,0./)) 47 48 CALL suphel 49 !ntime=4320 50 ntime=10000000 51 dayref=1 52 anneeref=2000 53 CALL getin('dayref',dayref) 54 CALL getin('anneeref',anneeref) 55 CALL getin('calend',calend) 56 CALL getin('day_step',day_step) 57 calendrier=calend 58 IF ( calendrier == "earth_360d" ) calendrier="360_day" 59 60 61 jour0=dayref 62 mois0=(jour0-1)/30+1 63 jour0=jour0-30*((jour0-1)/30) 64 an0=anneeref 65 66 !PRINT*,"REPLAY1D jour0,mois0,an0",jour0,mois0,an0 67 68 69 klon=1 70 klev=llm 71 CALL iotd_ini('phys.nc',1,1,klev,0.,0.,presnivs,jour0,mois0,an0,0.,86400./day_step,calendrier) 72 ! Consistent with ... CALL iophys_ini(600.) 73 74 !--------------------------------------------------------------------- 75 ! Initialisation de la parametrisation 76 !--------------------------------------------------------------------- 77 CALL call_ini_replay 78 79 !--------------------------------------------------------------------- 80 ! Boucle en temps sur l'appel à la parametrisation 81 !--------------------------------------------------------------------- 82 CALL call_param_replay(klon,klev) 74 !--------------------------------------------------------------------- 75 ! Boucle en temps sur l'appel à la parametrisation 76 !--------------------------------------------------------------------- 77 CALL call_param_replay(klon, klev) 83 78 84 79 end … … 93 88 94 89 !======================================================================= 95 96 97 ! Stops the simulation cleanly, closing files and printing various98 ! comments99 !=======================================================================90 SUBROUTINE abort_gcm(modname, message, ierr) 91 USE IOIPSL 92 ! Stops the simulation cleanly, closing files and printing various 93 ! comments 94 !======================================================================= 100 95 101 ! Input: modname = name of calling program 102 ! message = stuff to print 103 ! ierr = severity of situation ( = 0 normal ) 104 105 CHARACTER(LEN=*) modname 106 INTEGER ierr 107 CHARACTER(LEN=*) message 108 109 WRITE(*,*) 'in abort_gcm' 110 CALL histclo 111 WRITE(*,*) 'out of histclo' 112 WRITE(*,*) 'Stopping in ', modname 113 WRITE(*,*) 'Reason = ',message 114 CALL getin_dump 96 ! Input: modname = name of calling program 97 ! message = stuff to print 98 ! ierr = severity of situation ( = 0 normal ) 115 99 116 IF (ierr == 0) THEN 117 WRITE(*,*) 'Everything is cool' 118 else 119 WRITE(*,*) 'Houston, we have a problem ', ierr 120 endif 121 STOP 122 END 100 CHARACTER(LEN = *) modname 101 INTEGER ierr 102 CHARACTER(LEN = *) message 103 104 WRITE(*, *) 'in abort_gcm' 105 CALL histclo 106 WRITE(*, *) 'out of histclo' 107 WRITE(*, *) 'Stopping in ', modname 108 WRITE(*, *) 'Reason = ', message 109 CALL getin_dump 110 111 IF (ierr == 0) THEN 112 WRITE(*, *) 'Everything is cool' 113 else 114 WRITE(*, *) 'Houston, we have a problem ', ierr 115 endif 116 STOP 117 END 123 118 124 119 !======================================================================= 125 SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi) 126 IMPLICIT NONE 127 ! passage d'un champ de la grille scalaire a la grille physique 128 !======================================================================= 129 130 !----------------------------------------------------------------------- 131 ! declarations: 132 ! ------------- 133 134 INTEGER im,jm,ngrid,nfield 135 REAL pdyn(im,jm,nfield) 136 REAL pfi(ngrid,nfield) 137 138 INTEGER j,ifield,ig 139 140 !----------------------------------------------------------------------- 141 ! calcul: 142 ! ------- 143 144 IF(ngrid/=2+(jm-2)*(im-1).AND.ngrid/=1) & 145 STOP 'probleme de dim' 146 ! traitement des poles 147 CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid) 148 CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid) 149 150 ! traitement des point normaux 151 DO ifield=1,nfield 152 DO j=2,jm-1 153 ig=2+(j-2)*(im-1) 154 CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1) 155 ENDDO 156 ENDDO 157 158 RETURN 159 END 120 SUBROUTINE gr_dyn_fi(nfield, im, jm, ngrid, pdyn, pfi) 121 USE lmdz_ssum_scopy, ONLY: scopy 122 123 IMPLICIT NONE 124 ! passage d'un champ de la grille scalaire a la grille physique 125 !======================================================================= 126 127 !----------------------------------------------------------------------- 128 ! declarations: 129 ! ------------- 130 131 INTEGER im, jm, ngrid, nfield 132 REAL pdyn(im, jm, nfield) 133 REAL pfi(ngrid, nfield) 134 135 INTEGER j, ifield, ig 136 137 !----------------------------------------------------------------------- 138 ! calcul: 139 ! ------- 140 141 IF(ngrid/=2 + (jm - 2) * (im - 1).AND.ngrid/=1) & 142 STOP 'probleme de dim' 143 ! traitement des poles 144 CALL SCOPY(nfield, pdyn, im * jm, pfi, ngrid) 145 CALL SCOPY(nfield, pdyn(1, jm, 1), im * jm, pfi(ngrid, 1), ngrid) 146 147 ! traitement des point normaux 148 DO ifield = 1, nfield 149 DO j = 2, jm - 1 150 ig = 2 + (j - 2) * (im - 1) 151 CALL SCOPY(im - 1, pdyn(1, j, ifield), 1, pfi(ig, ifield), 1) 152 ENDDO 153 ENDDO 154 155 RETURN 156 END
Note: See TracChangeset
for help on using the changeset viewer.