| 1 | SUBROUTINE relaxetat0(fichnom) |
|---|
| 2 | |
|---|
| 3 | use netcdf, only: nf90_get_var |
|---|
| 4 | use comuforc_h |
|---|
| 5 | use ioipsl_getincom |
|---|
| 6 | |
|---|
| 7 | IMPLICIT NONE |
|---|
| 8 | |
|---|
| 9 | !======================================================================= |
|---|
| 10 | ! Author: A. Spiga |
|---|
| 11 | ! Purpose: Read a simple relaxation field |
|---|
| 12 | !======================================================================= |
|---|
| 13 | |
|---|
| 14 | #include "dimensions.h" |
|---|
| 15 | #include "paramet.h" |
|---|
| 16 | #include "netcdf.inc" |
|---|
| 17 | #include "iniprint.h" |
|---|
| 18 | |
|---|
| 19 | ! INPUTS |
|---|
| 20 | CHARACTER*(*) fichnom |
|---|
| 21 | |
|---|
| 22 | ! VARIABLES |
|---|
| 23 | REAL ucov(iip1, jjp1,llm) |
|---|
| 24 | REAL press(llm) |
|---|
| 25 | INTEGER ierr, nid, nvarid |
|---|
| 26 | INTEGER i,j,l,ij |
|---|
| 27 | |
|---|
| 28 | !! OPEN NETCDF FILE |
|---|
| 29 | ierr = NF_OPEN (fichnom, NF_NOWRITE,nid) |
|---|
| 30 | IF (ierr.NE.NF_NOERR) THEN |
|---|
| 31 | write(lunout,*)'relaxetat0: Pb d''ouverture du fichier' |
|---|
| 32 | write(lunout,*)' ierr = ', ierr |
|---|
| 33 | CALL ABORT |
|---|
| 34 | ENDIF |
|---|
| 35 | |
|---|
| 36 | !! ALLOCATE RELAXATION FIELD |
|---|
| 37 | IF (.NOT.ALLOCATED(uforc)) ALLOCATE(uforc(ip1jmp1,llm)) |
|---|
| 38 | |
|---|
| 39 | !! READ RELAXATION FIELD |
|---|
| 40 | ierr = NF_INQ_VARID (nid, "ucov", nvarid) |
|---|
| 41 | IF (ierr .NE. NF_NOERR) THEN |
|---|
| 42 | write(lunout,*)"dynetat0: Le champ <ucov> est absent" |
|---|
| 43 | CALL abort |
|---|
| 44 | ENDIF |
|---|
| 45 | ierr = nf90_get_var(nid, nvarid, ucov) |
|---|
| 46 | IF (ierr .NE. NF_NOERR) THEN |
|---|
| 47 | write(lunout,*)"dynetat0: Lecture echouee pour <ucov>" |
|---|
| 48 | CALL abort |
|---|
| 49 | ENDIF |
|---|
| 50 | |
|---|
| 51 | !! TRANSFER TO SHARED VARIABLE IN comuforc_h MODULE |
|---|
| 52 | !! TBD --> check the relaxation field's dimensions are OK! |
|---|
| 53 | do l=1,llm |
|---|
| 54 | do j=1,jjp1 |
|---|
| 55 | do i=1,iip1 |
|---|
| 56 | ij=(j-1)*iip1+i |
|---|
| 57 | uforc(ij,l)=ucov(i,j,l) |
|---|
| 58 | enddo |
|---|
| 59 | enddo |
|---|
| 60 | enddo |
|---|
| 61 | |
|---|
| 62 | !! READ THE RELAXATION RATE IN SETTINGS |
|---|
| 63 | facwind = 1000. |
|---|
| 64 | CALL getin('facwind',facwind) |
|---|
| 65 | |
|---|
| 66 | !! CALCULATE ATTENUATION FACTOR WITH ALTITUDE |
|---|
| 67 | ierr = NF_INQ_VARID (nid, "presnivs", nvarid) |
|---|
| 68 | IF (ierr .NE. NF_NOERR) THEN |
|---|
| 69 | write(lunout,*)"dynetat0: Le champ <presnivs> est absent" |
|---|
| 70 | CALL abort |
|---|
| 71 | ENDIF |
|---|
| 72 | ierr = nf90_get_var(nid, nvarid, press) |
|---|
| 73 | IF (ierr .NE. NF_NOERR) THEN |
|---|
| 74 | write(lunout,*)"dynetat0: Lecture echouee pour <press>" |
|---|
| 75 | CALL abort |
|---|
| 76 | ENDIF |
|---|
| 77 | phalf = 1.e5 !! at this pressure, attenua is 0.5 |
|---|
| 78 | CALL getin('phalf',phalf) |
|---|
| 79 | !! attenua goes from 1 at lowermost levels to 0 at uppermost levels |
|---|
| 80 | IF (.NOT.ALLOCATED(attenua)) ALLOCATE(attenua(llm)) |
|---|
| 81 | attenua = 0.5*(1.+tanh(log10(press/phalf))) |
|---|
| 82 | |
|---|
| 83 | !! END |
|---|
| 84 | ierr = NF_CLOSE(nid) |
|---|
| 85 | RETURN |
|---|
| 86 | END |
|---|
